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rossy  low-velocity  surface  layer.  Seismic  wave  scattering  patterns 
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uonsc  c.  S.-i  waves  polarized  parallel  to  the  cavity  axis.  The  influence  of'the 
re  ^he  reflected  SH  waves  was  found  to  be  significant  enough 
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19.  Abstract  (cont'd) 


force  transducer  operating  on  the  electrical  arc  discharge  principle  is  recommended 
as  the  source  device  and  three-component  borehole-coupled  seismic  detectors  are 
recommended  for  complete  SH-wave  data  acquisition.  This  seismic  exploration  system, 
designed  to  operate  in  the  frequency  range  of  400-1,600  Hz  together  with  specialized 
data  processing  techniques  capable  of  preserving  the  high-frequency  timing  accuracies 
in  the  seismic  signals  and  enhancing  reflections  from  localized  cavity  targets, 
is  recommended  for  future  prototype  development  and  field  evalaution. 
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APPE^^UIX  A 

The  Green's  Function  for  the  Unbounded  Medium 


The  two-dimensional  Green's  function  for  an  unbounded  medium  in  the 
absence  of  a  surface  layer  is  a  solution  of  the  inhomogeneous  wave  equation 


(V 2+k2 )G(x ,y ;x ' ,y ' )  =  -6 (x-x* )6 (y-y ' )  . 


(A-1) 


To  find  the  solution,  the  wave  equation  is  first  referred  to  a  cartesian  coor¬ 
dinate  system  (x,y)  having  an  S'-wa-ve  line  source  at  the  origin 


(V^+k2)G(x,y)  =  -6(x)6(y) 


(A-2) 


and  is  then  transformed  to  a  wave  equation  in  polar  coordinates.  Thus,  the 
i  d  e  n  t  i  t  y 


/6(r)dr  =  1  =  //  6(x)6(y)dxdy  =  //  rdrdii6  (x)5  (y )  , 

s  s 


leriiis  to 


6(x)5(y)  = 


a’id  the  polar  coordinate  form  of  the  wave  equation  is 


1  S 

r  dr 


r  +  k2]G(r) 


2nr 


(A- 3' 


For  r  *  0,  this  equation  becomes 


^  r  9  r  ^ 


dr^ 


+  k2]c(r)  =  0 


(A-i.) 


The  solution  of  this  equation  is  the  Hankel  function  of  zero^^  order.  Since 
Equation  (A-4)  exhibits  a  singularity  at  r  =  0  and  the  Hankol  function  solu¬ 
tion  should  represent  an  outgoing  wave,  then 


G(r)  =  cI(^J^  *  )(kr  )  . 


\  I 


(A-5) 


The  constant  c  may  be  determined  by  matching  the  boundary  condition  at 
r  =  0.  Thus,  integrating  Equation  (A-3)  over  an  infinitesimal  area  T'rrdr  a.nd 
letting  r  -*■  0 ,  results  in 


lim  (  2it  r(--^-^^)  +  k.2j2iirG ( r  )dr }  =  -1 
r  0 


(A-6) 


Using  the  asymptotic  expression  for  the  Hankel  function 


Hq(  1  Hkr)  ^  j  ~  log  (kr ) 
kr  ->■  0 


substituting  G(r)  =  c  log  (kr)  into  Equation  (A-6)  yields 


lim  { +  k^AcjJr  log  (kr)dr)  =  -1 
r  0 


from  which  it  follows  that 


and,  from  Equation  (A-5), 


c  =  i 


G(r)  =  i  Ho<l)(kr) 


This  result  is  tlie  two-dimensional  Green's  function  in  cylindrical  ci>i'irdi- 
nates.  A  more  general  representat  ion  of  ttiis  solution  for  an  S!i-'wave  line 
source  at  (r',ip')  and  a  detector  point  located  at  (r,4))  is 


=  h  [j’xHo(‘>(Mr-r'|] 


(A- 7) 


Introiiucing  the  spectral  representation  of  the  Hankel  function  as  giv'en 
by  Stinson  (1976),  the  free-space  Green's  function  in  cartesian  coordinates 
takes  the  form 


i  pja(x-x '  )  .,  ,  , 

G(x,y;x',y')  -  f-  J  -  eJ^(y-y'7d\ 


(A-8) 


A-2 
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THE  INTEGRAL  EQUATION  FORMULATION 


APPENDIX  B 


The  I  nteg  r  a  1  E^ii  a  tion  Formulat  i  mi 


The 

incident 


total  wave  displacement  in  a  medium  is  composed  of 
wave  and  the  scattered  wave  Thu , 


two  parts: 


tiv 


yt  =  ^  ^  ^  . 


(B-1) 


Each  wave  function  satisfies  the  Helmholtz  first  (interior)  and  second  (exte¬ 
rior)  formulas.  The  geometry  representing  the  first  Helmholtz  equation  is 
illustrated  in  Figure  B-1.  This  first  equation  is  given  by 


//jG(r.r') 


5u(  r ' ) 
d  r 


u(r') 


aG(r  ,  r  '  ) 
d  r 


]dS  = 


u(r);  for  r  inside  S 
0;  for  r  outside  S 


(3-2) 


where  G(r,r')  is  the  Green's  function. 


FIGURE  B-1.  GEOMETRY  OF  THE  OBSERVATION  POINT  P(r)  AND  SOURCE  POINT  Q(r') 

FOR  THE  HELMHOLTZ  INTERIOR  PROBLEM 


The  Helmholtz  interior  formula  is  applicable  to  the  case  when  all  of  the  sin¬ 
gularities  of  the  function  u(r)  lie  outside  of  the  surface  S.  That  is,  it  is 
valid  only  when  the  function  u(r)  and  its  first  and  second  partial  derivatives 
are  continuous  on  or  inside  of  the  surf. ice  S. 


B-1 


Alternatively,  if  all  of  the  singularities  of  u(r)  lie  within  a  close.; 
surface,  S,  the  Green's  identity  given  by 

///  (u72g  -  G72u)dV  =  //  (u  ^  -  G  ^)dS  ,  (3-3) 

S  dr  5r 


nay  be  applied  to  the  region  V  bounded  internally  by  S  and  externally  by 
another  closed  surface  F.  That  is,  for  example,  by  the  surface  (jf  a  sp  .er.- 
with  the  center  at  the  origin  and  having  a  large  radius,  R,  as  i  1  lus t r a t ec  i  n 
Figure  B-2. 


FIGURE  B-2.  GEOMETRY  FOR  THE  OBSERVATION  POINT  P(r)  AND  A  SOURCE  POINT  .((r') 

FOR  WAVES  EXTERIOR  TO  THE  SURFACE  S 


For  this  case,  the  Helmholtz  second  (exterior)  formula  is  used  and  is  given 
by 


//  [u(r')  -  G(r,r')  — .~]dS  =  ( 


u(r);  for  r  outside  S 


(B-4) 


0;  for  r  inside  S 


The  scattered  wave  displacement,  u® ,  which  physically  represents  the 
waves  radiated  by  secondary  sources  on  or  ’nside  the  surface,  S,  usually  is 
singular  inside  Vg.  Thus,  Helmholtz's  so  id  formula  is  applicable  with 

ff  ruS(r')  -  G(r,r’)  ^'*i^-’-^^]dS  =  u^Cr)  ;  for  r  in  V  .  (B-5) 

S  dr  dr 


B-2 


In  addicioii,  the  incident  wave  d  ispl  ncetien  t ,  which  has  no  sin^^ularity 

inside  the  boundary,  S,  satisfies  the  first  Helmholt:'.  formula 


//  [G(r,r')  -  u(i)(r-) 


0;  forrinV. 


(B-6) 


Adding  Equations  (B-5)  and  (B-6)  and  substituting  the  result  into  Equation 
(B-l)  yield?  the  total  wave  displacera«.-nt  function  as 


i(t)  =  ^j(i)  +  JJ  [u(t)(r')  -  G(r,r')  ]dS  ;  for  r  in  V  .  (B-7) 

s'-  dr'  dr' 


Since  the  Green's  function  G(r,r')  is  known.  Equation  (B-7)  states  that  the 
scattered  waves  in  the  region  V,  outside  of  the  boundary  surface  S  of  the 
scatterer,  can  be  found  from  an  integration  over  S  if  the  values  of  and 

du^  ^ ) 

on  the  surface  are  known.  For  example,  for  a  cylindrical  air-filled 

cavity,  the  normal  derivative  of  the  total  wave  displacement  vanishes  at  the 
surface  S,  (i.e.,  a  stress-free  boundary  condition).  Then  the  total  wave 
displacement,  o'- ,  at  the  surface  S  satisfies  the  integral  equation 


f  u(t)(r') 

dr  d  r  S  dr ' 


dS  ;  for  r  on  S  . 


(B-8) 


Arter  ttie  value  for  u^^^fr)  at  the  surface  r  =  a  is  found,  the  total  wave  dis- 
placem.u.t  for  values  of  r  >  a  can  be  determined  us  i  .',g  the  integral  equation 
ior  r  in  V  given  by 


u(t)(r)  =  u(i)(r)  +•  /  u ( t  > ( r  '  )  — ^  dS 

S  dr' 


(B-9) 
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APPENDIX  C 


Foraal  Solution  the  Integral 

The  integral  given  in  Equation  (107a)  may  be  transformed  into  a  more 

convenient  form  for  nunericai  evaluation.  This  integral  can  be  converted  to  an 
integral  having  limits  of  integration  between  0  to  ®  using  the  transformation 


(...)ej9"d\  =  / 

i  0 


-  k2^ 
k2 


(-X  +  /  -  k2^ 

k2 


dX  .  (C-1) 


Thus,  the  integral  P__  can  be  reduced  to 


nra 


JTI  •'  0 


/^e2(n) 


^-2k2(Tr-l)l/2(H-h) 


(n  +  /ti2_i  ) 


n+m 


wh-.- 


vk'  : 


i  i  >:  h 


an. 


,  - ,  n+m 

("h  +  /q2-i  )  _ 


dq 


,  ,-2k2(n2-v2)l/2 

e2(q)  = - 

I  -  Ro-‘-'^2(n2-v-) 


,2(,2V)J^2^(^2_i)1/2 

^2(q2_,2)l/2  ,  (^2_i)1/2 


•2  =  iLi  . 
^^2  ’ 


7 

k2  ’ 


k2  = 


C2 


C-1 


(C-2) 


The  integral  P^jj,  can  be  evaluated  along  the  contour  shown  in  Figure  C-1  .  "raOi 
points  exist  at  (1,0)  and  (v,0).  The  branch  lines  (0-1)  and  0-v)  separate  the 
regions  w'-ere  rm(h^-v^)^/^  and  Ini(T)^-l  )  ^ -^^  are  positive  (above  the  rtf^-axis)  fr. 
Che  regions  where  both  of  the  quantities  are  negative  (below  the  p^-axis). 
that  Re  (n  2-v  2  )  1 /2  3^^  Re(r|-l)l/2  are  always  positive  (the  integrals  will  not 
converge  otherwise).  In  addition,  simple  poles  are  located  at 


I  -  Re 


-2k2(q2-v2)l/2 


This  resonance  equation  has  real  solutions  in  the  interval  1  <  q  ^  \  j  ■: 

-  (  p )  -  ( ?  ; 

top  Riemann  s''  et,  and  complex  solutions,  to  be  denoted  by  q  ,  for  n  r 
on  the  lower  Riemann  sheet.  The  former  describes  spectral  iitdal  fields  : 
inside  the  top  layer  and  which  decay  into  the  bottom  layer,  w'lcroas  t'^.e  : 
describes  nonspectral  leaky  modal  fields  that  transmit  energy  into  the  '• 
layer  (Kamel  ond  Felsen,  1981). 


LEAKY  MODE 
—  POLES 


/- ■  irvMrrcu 

X  X  ’  f  y 

- ^*X_| 


-  TRAPPED  MODE  POLES 


-  .  RR 


0 


FML'RE  C-1.  CONTOL’R  OF  INTEGRATION  TO  EVALUATE  THE  FUNCTION  P,. 


Thus,  the  integral  P,,^  can  be  evaluated  along  the  contour  illustrated  in  Fig:j 
C-1  as  follows 


Pam  =  /„  (  )‘^hR  =  /_  (  +  /  (  )dq  +  /  (  )dq  +  /  (  )dnR 

^  A  0  C 


where: 


n  "  OR  +  jni 


c-2 


T 


This  schenu'  of  integration  has  been  applied  and  tested  using  the  integra] 
form  ot  the  HanV'.el  function  by  El-Akily  (1930).  In  fact,  to  check  the  nans-ri- 
cal  evaluation  of  the  int  'gr.il,  the  integral  form  of  the  Hankol  fumttion 

Hn(2k2]H-h])  nuy  be  used.  This  Hankel  function  can  be  deducei  by  making 
£2(9)  =  1  in  Equation  (C-2);  that  is, 


Hn(2k2!H-h! ) 


4-  r 


^-2k2(Ti2-l  )(H-h) 

■(^217)172 


-t-  /r|2-Y  ] 


n+ui 


+  (  -T1 


+  /ri2-l  )  }dri 


(C-5) 


z: 

^  V  * 


■Jf 


C-3 


APPENDIX  D 


ASYMPTOTIC  SOLUTION  OF  THE  INTEGRAL  P, 


APPENDIX  D 


Asyinpiotic  Solution  of  the  Inttegral 


Making  the  substitution  X  =  k2  sin  0  in  the  integral  P^jn  given  by  Equa¬ 
tion  (107a)  leads  to 


(D-1  ) 


where  the  integration  path  F  is  shown  in  Figure  D-1  and  £2^3)  is  given  by 


„  2 jk2h( v^-s in^0  )  ^ 

-R  4-  a  ^ 


1  -  Re 


2jk2h(v^-sii\^0)^'^“ 


(D-2) 


in  which 


D  =  §3 ~sj n^0 )  ^ cos  0 

^  2 2_2iQ20 )  I /2  +  Q 


.2  =iil. 


in 


•  % 


III. 


D-l 


■r 


0| 


FIGURE  D-1.  INTEGRATION  PATH  FOR  THE  INTEGRAL 
IN  THE  COMPLEX-ANGLE  (0)  PLANE 


The  asymtotic  solution  of  the  integral  P^j^  nay  be  derived  using  the 
saddle-point  nethod  as  describ(?d  in  Kong  (1986).  To  obtain  an  appropriate 
form  of  the  integral  given  in  Equation  (D-1)  and  to  remove  the  singularities 
from  the  resonance  equation,  the  integrand,  C2(Q),  may  be  expanded  in  a  power 
series  as 


£2(9)  =  -  — 
1 


+  g2jk2ha 
_  Rg2jk2ha 


I  [RAe"j‘'2ha(Jl+l  )  _  +  jk2haJl  j 

Jl=0 


(D-3) 


where : 

a  =  (v2  -sin  20)1/2  . 


Equation  (D-1)  may  then  be  expressed  as 


Pnm  =  (-!)"+">-  I  {/  je("^™)e^->‘^2(H-h)  cos  6^^ 

Jl=0  P 

-  I  RA  +  le^j'^2“l^-^  *  j9(n+ra)^2jk2(H-h)  cos 


D-2 


L 


Each  intec  cal  of  Equation  (D~4)  may  be  represented  in  the  form 


Iji(T))  =  /^d9Kji(9)ehf(0) 


where  q  is  a  large  parameter.  Equation  (D-5)  has  been  derived  by  the  saddle- 
point  method  and  is  (Kong,  1986) 


Fj^(9o)e 


hf  (9o  ) 


/- 


2k 

nf** 


{1 


dqf 


p 

f  F 


i  (f  "  ' )“  _  F_'j 

4  f"  12  (f")2  F 


(D-6  ) 


where  9q  is  the  saddle  point. 

From  Equation  (D-4),  the  function,  f,  for  the  first  integral  is 


fj^  +  l  =  j[cos  0 


^h(jl_+J) 

H-h 


and  is,  for  the  second  integral 


=  j[' 


9  + 


oM.  1 

H-h-l 


from  which  the  parameter  q  is  deduced  to  be 


q  =  2k2(H-h)  . 

Since  the  integrals  of  Equation  (D-4)  have  the  same  form,  the  saddle  point, 
9o>  is  determined  for  the  first  integral  to  be 


'^hich  give;-. 


39 


j[  cos 


9 


H-h  J 


0 


9  =  rm;  for  n  =  0,*:l,t2, 


* 


D-3 


Since  the  saddle  jioint  must  h'  within  the  int<irval  /  2  <  0^  <  ^/2,  ilu:-n  0q 
must  be  equal  to  zero.  Thereiore,  evaluating  the  derivatives  of  th.e  ‘’unction 
f  =  f£+j(0)  at  0Q  =  0  and  substituting  then  into  Equation  (D-6)  yields 


Ijl(ri)  =  Fji(9^)e 


,  2rK2<,.-h)(i 


2Jk2[l 


(H-h)v' 


'  L  tu  s  ^  r  1  4.  h(A  +  l  )  1  ^  A 
sk2(H-h)  [  1  + 


1  +  —  eo-i-il  1  -  -,-~2 


,  ej^  +  i 

1  + - 

V 


where : 


h(Jl+l ) 

=  Tr-h— 


and  determined. 


For  convenience,  the  function  Fj  =  Fj^(9)  is  defined  as 


(2-7) 


R  =  R(0) 


In  order  to  evaluate  F.quation  (D-7)  for  9q  =  0,  the  function  F;^  and  il'.e 
ratio  Fjj^''/Fjj^  are  required.  The  second  derivative  of  F.quation  (D-8)  is 
derived  to  be 


F  .  .  =  ^9c  {.‘L^a  +  2c  -jg-  + 
dG^  '^0 


(D-9) 


_  dR  . 

- =  a.Ra  t  --  ; 

dO  ii9 


d0  2  dQ  ,10  2 


where  : 


dR  _  sin  9 

dO  (C^a  +  cos  9)^ 


d-R  _  ^  I Q^ol  ci)s  9  +  sin^9  +  l] 

^  \  'X  )  ~j  • 

dO  -  (C  “"i  +  cos  9  ) 


At  tht>  sadd  1  n-po in L  9q  =  0,  the  ratio  between  Equation  (D-9)  and  D-8)  is 


^  fjl  (C2v)2  -  I 


(D-LO) 


an'  the  function  Fji^(C)  is  given  by 


(Fi),  ■  8-' 


In  the  first  integral  of  Equation  (0-4),  defined  as 


II  =  i  /  RAe^‘^2(H-h)[cos  9  +  jO(n^a)^g  , 

Jl=0  ^ 


(D-11  ) 


the  function  Fj^  at  saddle  point  9q  =  0  is 


F,^(0)  = 


(D-12) 


]  =  _„2C.\v_(l_ 

f'jl  9„=0  .,9  ^"2  . 


(n+;;i)2 


'o=u  (r,2v)  -  1 


(0-13) 


Thus,  the  asymtotic  solution  of  the  integral  Ij  is 


~  ^  ^2jk2(H-h)  +  2jk2h(?.  +  I)v  "  r  j 


2k2( (h-h)  +  h 


(A  +  l). 


X  Ri  1  -  - j.  .  I 

4k2[(H-h)  +-^-^-^--•^1  J*  (C2v)‘'  -  1 


(0-14) 


and 


I2  ~  ^2jk2(H-h)  +  2jk2Mv 

Jl=0 


11 

A 


j _ 2u^.. 

2k2[ (H-h) 


1 

L 


X  rA+1 


Ak2[(H-h)  +  -^] 


1  .  2c2v(i  +  l)  .  ,  ,  ,0 
_  +  — ^ - +  (n+n)- 


(C^v)^ 


1 


(0-15) 


Finally,  replacing  the  asymptotic  solutions  of  the  integrals  1]^  and  It  in 
F.quation  (D-4)  leads  to  the  asymptotic  solution  of  the  integral,  Pnni' 
is. 


V  2jk2[H-h+h(A+l )v]-  7  j  7  (n+m)j 
nm  =  /,  ®  4  <1 

Jl=0 


X 


_ _ ^ 

2k2[(H-h)  + 


(A  +  Dhi 

V  ■' 


J. 

2 


R-^ 


4k2[(H-h)  F  — 


2c2vi 

(C’v)^  -  1 


(  n  +ra )  2  I 


_  ^  H-h+Mv]-  I  j  y 

1=0 


(n+m)  j 


_ 2 _ 

2k2[H-h  + 


1 

2 


X  +  l  I 


Ak2[(H-h)  +  ^]J 


+  2c2v(A-t-l) 

(C^v)"  -  1 


(n+ra)2 


for  CjP  <  p2'^2  ’ 


(D-16) 


In  the  optical  limit  as 


2k2{(H-h)J  ►  <0 


D-6 


the  following  appioximate  e:■;pre^3sion  for  the  integral  may  be  obtnim 

terns  of  Haiikel  functions.  That  is, 


A=0 


-  I  ,[(a-h)  + 

2=0 


whe  re  : 


32  +  1 


,  +  h(2+l)v 
H-h 


a.  iLClll) 

(H-h)v 


and 


^2 


I  + 


1  + 


h2j' 

_H}-_h_ 

_h2_ 

(H-h)'v 


2 


In  order  to  simplify  nur,r?rlcal  calcvilat  ions ,  the  approximate  solution  o 
give;;  by  Equation  (D-17)  may  be  written  as 


P 


nra 


C^v  -  1 
C^v  +  1 


Ut,Vro(2k2(H-h)) 


2.  _  I 

+  I 


s -v 
2 


2-1 


C£y  - 

C^v  +  I 


2  +  1 


Hn+m('^2S2) 


in  which 


V  =  ki/k2  ; 

Sf_  =  2(H-h+hiv)  ; 

t-  n2 

1  +  htv/(H-h) 

"  r~+“h)l/(H-h)v 


D-8 
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APPENDIX  E 

SH-WAVE  SEISMIC  PULSES  R.ADIATED  BY  A  LINE  SOURCE 
IN  A  TWO-LAYER  IL\LF-SPACE 
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APPENDIX  E 


SH-N'ave  Seismic  Pulses  Radiated  by  a  I,ine_  Sourc_e  i_n  a  J^p^bayo'  iia  1  t-Sya  s- 
E.l  The  Incident  Field  and  Its  Rej)  to sen  tat  ion 


The  transient  Sli-wave  displacement  for  a  line  source  located  at  the  source 
position  (x^.y^)  in  the  bedrock  semi -inf in i te  half-space  satisfies  the  wave 
equa  t i ons  : 


p  iV 


“■U 


=  Pi 


for  0  <  X  4  h 


and 


(F.-1  ) 


P2'^  “  P  2 


-6 (x-Xg )6 (y-ys )6 ( t ) 


for  X  >  h  . 


(£-2) 


The  transient  solution  for  cylindrical  wave  motion  may  be  developed  using 
the  Cagniard-deHoop  approach  described  in  dePaop  (1960)  and  in  Aki  arnl  Richards 
(1960).  This  solution  employs  the  Laplace  transform  of  the  SH-wave  displace- 
mei\t  for  a  line  source  in  an  unbounded  medium 


I  ^  a(x-xs)] 

u(x,y,Xs,yg,S)  =  Iml/^  -  dp}  , 


(E-3) 


rl  7,1/2 
a  =  (--  -  P-) 


R  =  [(x-xs)2  +  (y-y-g)’]^'^^  ;  and 


c  =  the  shear  wave  velocity. 


The  branch  cuts  determined  by  Re  a  >  0  and  the  path  p  =  p(t)  for  different 
values  of  t  are  shown  in  Figure  E-1.  The  function  p(t)  is  obtained  by  solving 
the  equation 


t  =  p(y-ys)  +  a(x-xg)  . 


ti  ORIGINAL  PATH  OF  \ 
^-INTEGRATION  FOR  THE  \ 
LAPLACE  TRANSFORM 


ix  -  x,i 


p  =  0 


■BP„\,\''H  CUT 


t  =  R/C 


FIGURE  E-1.  BRANCH  CUTS,  THE  INTEGRATION  PATH  FOR  THE  LAPLACE  TRANSFORM, 
AND  THE  CAGNIARD  PATH  C  IN  THE  COMPLEX  p-PLANE 


The  Cagniard  path  C  In  the  complex  p-pla..e  is  obtained  for  which  the 
quantity  p(yys)  +a(x-Xs)  is  real.  The  path  begins  at  t  =  0  on  th  ■  negative 
real  p-axis,  turns  on  the  branch  of  a  hyperbola  at  t  =  R/c  and  continues  on  a 
pa'-h  having  an  asymptote  at  an  angle  0  =  tan”^  (y-yg)/ 1  x-Xg  |  with  respect  to 
the  positive  imaginary  p-axis.  Note  that  on  the  real  p-axis  the  path  C  cannot 
lie  on  the  branch  cuts.  Figure  E-1  also  shows  part  of  a  large  arc,  Cj,  in  the 
first  quadrant  connecting  the  imaginary  p-axis  and  the  path  C.  The  angle  6 
may  be  identified  as  the  angle  of  incidence  of  the  ray  from  the  source  to  a 
d’-tector. 


There  is  no  contribution  from  the  integrand  of  Equation  (E-3)  along  that 
part  of  the  path  C  between  t  =  0  and  t  =  R/c,  since  p  is  purely  real.  Neitb.er 
is  there  a  constribut ion  from  the  large  arc  Cj  in  the  first  quadrant.  Since 
there  are  no  singularities  between  the  path  C  and  the  positive  imaginary 
p-axis,  Aki  and  Richards  (1980)  .ijnclnde  that  the  Laplace  transform  of  the 
SH-wave  displacement  for  a  line  source  in  an  unbounded  medium,  in  terms  of  rhe 
Cagniard  path  C,  is 


ii(x,y,x„.y,,,S)  = - Imf  f 


,-S[p(y-yg)  +a(x-Xs)] 


(E-A  ) 


t.  2  _ SH-Wave  Displacoraents  in  a  Two-Layer  Half-Spacf 

The  integral  repr-‘s..ei  r  a  f  i  on  of  the  wave  displacenent  given  by  Equation 
(E-4)  may  be  generalised  for  the  SH-wave  d isplaceiaent  in  regiiari'^  of  diffe^'eat 
elastic  properties.  Thus, 

For  the  region  0  <  x  <  h: 


1  o  ^  ~Sp ( v-y o ) 

uj  =  -  _  Im{/  [ fi(p)e  +  gi(p)e  dp} 

dixp2C2‘'  4 


(E-5) 


For  the  region  x  >  h: 


2np2C22  C*-  " 


(z-6 ) 


vho  re  : 


r  I  2^1/2 

OEi  =  -  p-) 


.1  0,1/2 
ao  =  (— ay  -  P') 
c  >*- 


The  factors  fjCp),  g^Cp),  and  f2(p)  are  arbitrary  frinotions  of  p  which  rer. 
the  integrals  convergent  and  satisfy  the  following  bound  try  conditions: 


Ac  the  surface: 


Yx' Jx=0  *  0  • 


At  Che  layer  interface: 


d'x^'^x-h 


^^2  ^ x=h 


(u2)  . 

^  x=h 


(E-7) 


E-'i 


Those  bau’iii.jry  runditions  I'oid  to  three  lineir  .ilj^ebruc  equations  to  ^Oive 
‘or  the  unknown  coeff’cients  fjCp),  !tl(p),  a'ld  solution  of  tlie 

Sli-wave  d  i  s  p  1  a  Cere  !i  t  s  for  the  surface  layer  and  the  cavity  hiost  rnediuni  ;  s  : 

For  the  i eg  ion  0  <  x  <  h: 


Ui(S) 


_ 1 _ 

:tiP2C22 


Im(J^ei(p) 


g-S[p(y-ys) 

«2 


+  a2(xs"^)  5 


^  ^^-Sai(x+h)  ^  (--S) 


For  the  region  x  >  h: 


“S[p(y-yg)  +  a2(x-K^)J 

U2(S)  dpi 

2-np  2^2^  ^ 


, - 1__  I„,{r  ^  ^2(x-Xs)]j  I 

2^pc22  C  ‘^2 


where  : 


V _ _ . 


c  2  ( P  ) 


-R(p)_  +_ 


1  -  R(p)e 


(K-r) 


T(p) 


2^212 

Piai  +  h2'=‘2 


R(p) 


Piai  ^  h2«2 
til'll  +  ti2^2 


(i>n ) 


R-4 


E.2.1  Detiectof  in  tho  RodrocV'. 

The  first  integral  of  Eqintion  (E-9)  represents  tho  inci'hent  S!l-wave 
d  isp  Inceraent  ,  ua^^^CS),  for  a  lin<'  source  in  an  unbounded  meiiiuL:  haeing  an 
SH-wavo  velocity,  C2«  Applying  an  inversion  technique  developed  by  dedoop 
(  1960)  and  presented  by  .Aki  and  Richards  (1980),  the  integrand  of  the  incid>:it 
SH-wave  displace;;ieat ,  U2^^^(3),  may  be  inverted  in  terms  of  the  time  variabl'^' 
of  integration,  t,  to  yield 


UT^^  ^(S) 


_ i_  r  _ e-st _ 


l/'2 


(E-12) 


from  which  the  de 1 ta -f unc t ion  response  can  be  identified  and  is  given  by 


U2^^^(t) 


1 

n  ~2 

2tp2C2 


H(C-tg) 

(V2T^T/2 

s 


for  t  >  tg 


(E-n) 


where ; 


Rg  =  [(x-xg)‘  +  ;  and 

tg  =  Rg/Cg  =  arrival  time  at  the  detector  location. 


The  second  term  of  Equation  (E-9),  02'”'^’' (S ) ,  gives  the  generalized  reflection 
resp..,;,^,.  in  tVie  bedrock  mediura.  The  function  e2^P^  ^"*1'  expressed  n.s  a 
posvt  series  expansion  of  the  denominator 


1 


N 


- - J  =  y 

1  -  Re-''^“l  ^=0 


-2Shia 


(E-14) 


yield. 


e2(p)  =  I  -  I  RUle--2^^ih^  ^  (E.15) 

Jl=0  t=0 

'^liere  N  is  the  total  number  of  reflections  within  the  surface  layer.  Substi¬ 
tuting  Equ.ntion  (E-15)  into  the  second  term  of  Equation  (E-9),  the  generalized 
reflection  Is 


u/'"(S)  . i-,-  S  ,„/*  (J'-'i'i  -teje-St 

2W2C2'  slo  «2  p=p,*,U) 


2Ttp2C2^  i=0  tji  “2  p=pj^(t) 


(E-l-j) 


In  the  time  domain,  the  generalized  reflection  displacemi-nt  in  the 
delta-function  response  can  be  identified  directly  from  Equation  (E-!b)  -nd 
is  thereby 


/“T  1  I  7^]  H(t-t£  +  i) 

P=Pl+l(t) 


-  refl.  . 

'^2  —  2  ‘  ^  a-)  df* 

-np2C2‘^  f=0  “2  at 


-  f  ^-1 


i=0 


a2  dt ' 


P=Pjl(t) 


H(t-tj^)l  , 


(E-17) 


where  Pi(t)  and  Pi,  +  i(t)  are  solutions  of  the  nonlinear  equations  given  by 


t  =  pCy-yg)  +  a2(x+Xg-2h)  +  jht 


(E-18) 


and 


t  =  p(y-yg)  +  a2(x+Xs-2h)  +  Zijh(l+1)  , 


iE-19) 


respectively.  The  time  derivatives  of  the  variable,  p,  associated  with  ^i', na¬ 
tions  (E-18)  and  (E-19)  are  given  by 


and 


dp^ 

dt  ^ 


1 


(x+Xs“2h)Pj^  2hAPj^ 

(j,  )  a 


(E-20) 


dPijJ, 

dt 


_ _ _ 

,  (x+Xs"2h)Pjj-(.l  2h(A+l)Pi^  +  l 

y-y^,  _  ^YaTf) 


(E-21) 


E-6 


=  [--2  -  Pi)'"' 


aj(i  +  l)  =  (■— L  _  +  ;  for  j  =  1,2 


The  times  of  arrival  associated  with  the  first  and  the  second  ter'  ^  of 
iqastion  (E-17)  are  given  by 


x+xs"2h _ ^  _  2h(A  +  l ) 


C2 


COS  C  cos  0[ 


(«+l) 


(E-22) 


tj  - - 


x-t-Xc-2h 


(E-23) 


where  the  angles  9[  and  02  are  the  angles  of  the  ray  trajectories  in  the  sur¬ 
face  layer  and  in  the  serai-infinite  half-space,  respectively.  Each  term  of 
Equation  (E-17)  represents  a  ray  path  that  reaches  the  observation  point  after 
I  reflections  in  the  surface  layer.  In  fact,  the  multiples  occurring  within 
the  surface  layer  are  retained  and,  after  i  reflections,  the  Sd  wave  is  trans¬ 
mitted  into  the  bedrock  formation.  The  ray  contribution  associated  with  the 
first  terra  of  Equation  (E-17)  is  sh'iwn  in  Figure  E-2(a).  The  horizontal  dis¬ 
tance  between  source  and  detector  can  bo  inferred  directly  from  the  ray  go'jmo- 
try  shown  in  Figure  E-2(a)  as 


tj  +  l  =  (x+x^-2h)  tan  02^^^^^  +  2h(?  +  l)  tan  .  (E-2a) 


Similarly,  the  horizontal  distance  between  the  source  .ind  detector  for  the 
seconij  term  of  Equation  (E-17)  is  given  by 


rj^  =  (x+Xs-2h)  tan  92^^^  +  2h7  tan  9^^^^  .  (E-25) 

The  angles  9 ^ )  and  92^^^  may  be  obtained  for  an  arbitrary  point  of 
observation  p(x,y)  by  solving  the  following  systems  of  equations: 

=  (x*-Xj^-2h)  tan  92^^^  2h^,  tan 

=  p(n  (K-2h) 

C2  Cl 


SOURCE 


(bi 


(0 


FIGURE  E-2.  GF.OMKTRY  OF  SH-WAVK  RAY  PATHS  FROM  A  LIME  SOURCE  lO  A  nETKCIOR 
IN  THE  BEDROCK  LAYER  SHOWING  THE  CONTRIBUTIONS  ASSOCIATED  WITH 
THE  POWER  SERIES  EXPANSION  OF  EQUATION  (E-17) 


E-8 

M  -  - 


and 


rj^+2  “  (xi-:\5-2h)  tan  +  2li(i  +  l)  tan 


sin  sin 

C2  Cl 


p(^^n  . 


(£-: 


n 


These  equations  may  b'-  expressed  in  terms  of  the  ray-path  pararieter,  p,  as 


(x+Xg-2h )p 


(E-2«) 


/C2 


_n  0 


p=p(o 


and 


^+x  s-2h)p  __2_h  a  1 1  )p_  _ 


(£-29) 


/C2 


-2  -  „2 


/Cl 


9 


p=p(2>l) 


for  0  <  p  < 


For  a  prescribed  source-detector  pojition,  K<;u.iclons  (F.-2!^)  and  (F.-29) 
au'it  be  so  ■  ved  nunerically  for  the  ray  paraineter  p.  In  this  way  th--  pairs  of 
angles  of  incidences  92^)  92(''^'^j  may  be  determinf'd  and, 

substitut-'d  in  Equations  (E-22)  and  (E-29)  to  obtain  the  arrival  tines,  t|  and 
tjl  +  i  ,  for  I  =  0,1,2,...  N. 

-•2.!.!  Nunerical  i  tj!!:|_jaj  Solve  th.e  E.|^uation  p  =  p(t) 

Since  no  simple  analytical  relationships  exist  either  to  solve  Equa¬ 
tion  (E-18)  or  (E-19),  the  solution  of  p  =  p(t)  must  be  determined  with  the  aid 
oi  a  numerical  technique.  An  iterative  technique  can  be  applied  successfully 
if  the  starting  value  is  chosen  judiciously  (delloop,  1979).  Starting  values  of 
P  -  P  may  be  obtained  from  the  equation 


Ply-ysl  +  Cl/c2-p2)'/2n  =  t 


(E-30) 


wiere  the  unVaiown  quantities  H  and  C  are  selected  such  that  Equation  (E-3l)) 
^PProxim.ites  that  of  Equation  (E-IS)  or  (E-19).  In  particular,  values  C  and  H 
^fe  chosi'n  such  that  Equation  (E-30)  asymptotically  coincides  with  Equation 


-►  OO 


(l-!S)  or  (i:-19),  as  |p|  +  =  and  at  p  =  0.  For  example,  Equation  (E-18)  r.a> 
be  i  Npre-Jsed  in  terins  of  the  parameter  p  as 


PiV^ysl  (>^+Xg-2h)[  —  -  -  p"^)  +  21iX(  2  “  P^]  “  t 


:h,  for  large  values  of  |pi,  reduces  to 


P  =  t 


/[(y-ys)^  +  j(x+Xs-2h+2W)] 


(E-31  ) 


In  the  same  manner,  for  large  values  of  |p|  ,  Equation  (E-30)  reduces  to 


P  =  t/[(y-yg)  +  jH]  . 


(E-12) 


CL'imparing  Ecjuations  (E-31)  ind  (E-32),  it  follows  that 


H  =  x+xg  +  2h(Jl-l) 


The  second  conditions  for  Equations  (E-30)  and  (E-31)  are 


x+xs-2h  2hi 

p  =  0  at  t  =  — -  + - 

C2  c  1 


=  0  at  t  =  H/C  , 


from  which 


(x+Xg-2h)/c2  +  2K!./ci 

x+Xg+yh(T^r) 


Solving  Equation  (E-28),  the  starting  value  P^  to  be  used  for  pj^  in  Equation 
(E-18)  to  begin  the  iteration  process  is,  therefore 


iy_-ysl  _  _  _ r  2  -  ”a!.1 

^  |y-ysl^  +  ly-ysl^  +  ^a^ 


(E-33) 


for  [  (y-ys)2  +  11,^2]  /Cji  <  t  <  ®  , 


E-10 


who  re : 


=  x+X3+2h(J?.-I )  ;  and 


,x+x^;-2h 

^/Cjl  =  - +  ^"i)/[x+X3+2ha-l)] 


Alternatively,  the  starting  value  +  i  to  be  used  for  Pj^+i  to  begin  Eauation 

(E--19)  in  the  iterative  numerical  procedure  is 


|y-ysl  (y-ys)^  + 

; - V6 - t  - [t - 5- - J  (E-3u) 

|y-ysl^  +  H-,  |y-ysP  +  H2  cj 


for  [|y-ys!^  +  /Cji  +  1  <  < 

whe  re ; 

^i  +  1  ”  x+X5+2hJi  ;  and 

x+Xc"2h  2h(,i  +  l) 

=  [~7^ - ^  - - ]/(x-^Xs-H2lU)  . 


For  an  initial  value  of  £  >  tjj ,  the  starting  parameter,  P,  is  deter- 
tnin.ed  from  Equation  (E-31)  and  then  substituted  into  Equation  (E-18)  such  that 
the  following  requirements  for  the  Cagniard  contours  are  s.atisfied.  That  is, 

1/2  \  /  '2. 

Re[p(y-ys)  +  (  x+Xg-2h](— --  -  p2)  +  2h,i(-— -  -  p2]  j  =  t 

C2 


1/2  I  /  *^ 

Im[p(y-yy]  +  (x+Xs-2h](-^  -  p2)  +  2iU(— y  -  p2)  ]  =  0 


'^here  p  is  complex  and  t  is  real. 

For  example,  for  an  initial  parameter  p  =  Pl  +  jP2  ^tid  a  given  value 
t  greater  than  the  arrival  time,  tjj^,  the  equations 


fA  =  Pl|y-ysl  +  Re[gj[(p))  -  t 


(E-36) 


ffl  =  Pzly-ysl  +  ItnlgJKp)] 


in  which 


gj^(p)  =  [x+Xs-2h)(-^  -  p2)  +  2tu(  — 


1/2 


cj- 


may  be  implemented  in  a  numerical  procedure  for  solving  a  system  of  nonlinea: 
equations  for  the  unknowns  pj  and  P2»  Thus,  for  given  values  of  t  and  start¬ 
ing  values  of  the  complex  variable,  p,  a  Cagniard  contour  may  be  constructed 
and  used  to  evaluate  Equation  (E-17). 

E . 2 . 1 . 2  First  Motion  Approxima t i on 

In  order  to  simplify  the  analysis.  Equation  (E-17)  may  be  written 
with  only  one  summation  as 


~  ref,  , 
U2  (t) 


Im}_ 


dEl 

rr  J 


2iip2C22  «2  dt  p=Po(t) 


H(t-to) 


+  I  lm[(R-l  -  R)  H(t-tA)  , 

A  =  1  ""2  dt 


(E-37) 


where  Po(t)  and  Pji(t)  are  solutions  of  the  equations 


=  p(y“ys)  02 ^-X'*'Xs“2b ) 


(E-38a) 


and 


t  =  p(y-ys)  +  a2(x-'-Xs-2h)  +  TajhX  , 


(E-38b^ 


respectively.  The  time  derivatives  of  the  variable  p  associated  with  Eq na¬ 
tions  (E-38a)  and  (E-39b)  are  given  by 


^2. 

dt 


jc'2(Po) 


and 


dp.  =  __ 

dt 


I  I  ( x■^x<;-2h  .  2hJl  1 

ly-ysl  -  Pl-iir 


E-12 


Therefore,  the  first  teri:i  of  Equation  (E-3.)  may  be  expressed  in  closed  form 


Real[^(Po)] 


-  H(t-to) 


where 


'^o  =  +  ly-vgl^]  /c  ; 


Po(t) 


_ _ ^  .  _ _ (x+xs-2h)  _  f  2_  212 

(y-yg)^  +  (x+xs-2h)2  (y-ys)^  +  (x+xs-2h)2  ° 


Thus,  a  more  appropriate  form  for  the  total  SH-wave  displacement  for  the  delta- 
function  displacement  response  is 


U2(c)  = 


_ ^  J^Ct-tg)  ^al(R(po)l 

2^P2C2'  .,^“2  ,  72:-^ 


H(t-to) 


+  I  Im[(R-l  -  R) 

Jl  =  l  ^2  dt' 


ai  dt  ^  -  f  r  ■) 

^  p=pji'-ci 


H(t-ti)  • 


(E-39) 


To  reduce  numerical  computations,  the  first  motion  approximation  for 
Che  reflections  may  be  applied  to  the  summation  ter.n  of  Equation  (E-39).  In 
the  first-motion  approximation,  only  val  les  of  p  near  pjj  influence  the  behavior 
of  the  SH  -wave  displacement  (Helraberger,  1968).  In  Equation  (E-39)  the  only 
function  that  is  not  slowly  varying  near  pi  is  the  time  derivative  dp/dt.  This 
numerical  technique  requires  the  time,  t,  to  be  expanded  in  a  power  series 
about  the  time  of  arrival,  tjj^ ,  as 


(p"Px)  +  Y  (^|)  (p-Pi) 

p=pji  dp  p=p. 


2  +  .... 


(E-40) 


since  f  ^ 

^  dp^ 


‘(j^)  (.-»)' 


(E-41) 


E  - :  1 


Solving  Equation  (E-41)  for  p  and  taking  tlie  time  dcMivative  yields 


(j^-)  ■ 


ait  ,W2 

2' 

3P  p  =  pj^ 


The  second  tine  derivative  of  p(at  p=p^ )  is  obtained  from  Equation 
is  given  by 


(E-42) 


(E--3Sb)  .'ind 


2hJi 


3  2-' 

a  1  1 


(E-^3) 


Substituting  Equation  (E-42)  into  Equation  (E-39)  yields  the  first-motion 
approximation  for  reflections  in  the  surface  layer.  The  total  SH-uave 
displacement  for  the  delta-function  response  at  the  detector  location  is, 
therefore 


U2(t)  =  - ^ 

2np  2^2^ 


H(t-ts) 


Real[R(po)] 


/t 


2-^  2 


/<■ 


2-r  2 


H(t-to) 


where ; 


and 


I  - 

i=l 


0-2 


P=PA 


(2Si) 


1/2 


/ (t-ti ) 


x+Xo-2h 

Sjl  =  -y-T- 

a2'’c2^ 


+ 


2hX 

aj^ci 


2 


PA 


sin  02^^^ 
C2 


(2-H) 


The  first  terra  of  Equation  (E-44)  corresponds  to  the  direct  SH-wave  pulse  hav¬ 
ing  an  arrival  time,  tg,  while  the  second  term  represents  the  SH-wave  pulse 
reflected  in  the  bedrock-surface  layer  interface  having  an  arrival  time,  tQ. 
The  summation  terra  is  associated  with  multiple  reflections  of  SH-wave  pulses 
in  the  bedrock  and  in  the  surface  layer  having  arrival  times,  t^  (for  A  =  1,2, 
3,...  N). 


For  a  transient  SH-wave  pulse  acting  along  the  z-axis  parallel  to  the 
cylindrical  cavity  and  consisting  of  a  body  force,  f(t),  the  transient  SH-wave 
displacement  is  obtained  by  convolution;  that  is. 


E-14 


■ f .  aigjBy  I,  yi  i.tijpi  ..1  '2;  i.>j  piitW'.i','  !!»*:. 


't  _ 


U2(^)(t)  = - f(t)  *  T2^iHt) 

2tip2C2‘^ 


(^-45) 


and  its  time  derivative'  is 


du,(i^(t) 


dt 


J_ 

2tip2C2 


2  Mt 


(f(t)  *  T2(i)(t))} 


(E-45 ) 


whe  re ; 


“  H(t-Cg)  Real[R(po)l 

T2U)(t)  =  - H(t-to) 


/t-~Cs^  /t2-c^2 


*  i  i(«-‘  - ») 


tt,"  '«2'p.p,  (2S,)>«/ir-T0 


(E-47) 


in  which: 


and 


x+xs-2h  2h.i 
-  + 


a2 


3  2  3  2 

2  C2  '^1 


sin 


Pi 


CO 


E . 2 , 2  Detector  i n  the  Su r f ace  Layer 

The  SH-wave  displacement  for  the  line  source  in  the  bedrock  layer  and 
the  detector  in  the  surface  layer  as  given  by  Equation  (E-9)  may  be  expressed 
tn  terms  of  two  integrals 


-  1  I  In./ 

2mp2C22  A=0  ^ 

^  g-S{p(y-ys)  +  ai  lx+h(2A  +  l  )  +a2(.<s“^^^ 

.  ,  I  i.J  I-<iL)«<lO*,p 

Trp7c7>-0  ■:  «2 


*  e 


-S{p(y-yg)  +  aj (-x+h(2l+l )  +  a2(xg-h)}  . 


(E-48) 


Frora  those  expressions,  the  SH'-.-ave  displacement  at  th.e  surface  (x  =  0)  is 


1  2V  imf  +aih(2l  +  l)  +  -t2(>'s--h)Jdp  (0-4 


ui  =  - 


/•rtp2C2‘ 


Jl=0 


C  <^2 


E-49) 


and  the  generalized  reflection  displacement  is  given  by 


ui(S) 


2  I  Imf 

2tip2C22 


rlipJAlPli  d£le-st 

^2  dtJp^p^(t) 


dt 


(E-50' 


In  the  time  domain,  the  generalized  reflections  for  the  de 1 ta-f one  .  i on 
d  i  splacemiont  response  can  be  identified  directly  from  Equation  (F-30)  r- 


ui  (t ) 


00 


- 1-  2  I  In; 

2TtP2C2^  l=Q 


P  =  PA 


H(t-tj^) 

(t) 


(E-51) 


where  Pi(t)  is  a  solution  of  the  nonlinear  equation  given  by 

t  =  pCy-Vg)  +  a2(x5-h)  +  aih(2t+l)  .  (2-52) 

The  time  derivative  of  the  variable,  p,  associated  with  Equation  (E-52)  is 


d^ 

dt 


ly-ysl 


f  X  s 
Pl 


02 


ai  J 


(E-33  ) 


in  which 


=  (-'T  ■  :  for  j  =  1,  2  . 


The  equation  to  compute  the  limes  of  arrival  of  the  reflections  for  a 
detector  at  the  surface  is  given  by 


tA 


C2 


h _ 

cos  02^'^^ 


+ 


__h(_2A_+J_)__ 
C 1  cos  01^^^ 


(E-59) 


E-16 


where  the  an-^les  9  ^  and  02  are  the  angles  of  the  ray  t  raj  t  ■>  r  i  es  in  the  sur¬ 

face  layer  and  in  the  scni-inf inite  half-space,  respectively.  The  ray  con^ri- 
butio[i  associated  with  Equation  (E-54)  is  shown  in  Figure  F.-3.  The  hci  r  i /.s'  ■  t  i 
distance  between  source  and  detector  can  be  inferred  directly  fror\  the  ray 
georaetry  shown  in  Figure  E-3  as 


r^  -  (x5-h)  tan  02^^^  h(2?.  +  l)  tan  . 


The  angles  and  02^^^  nay  be  obtained  for  an  arbitrary  point  of  observa¬ 

tion  p(x,y)  by  solving  the  following  syst-  a  of  equations; 


rj^  =  (x^-h)  tan  02^'^^  "*■  h(2l  +  l)  tan  9^^^^ 


(E-53) 


sin  9?^^^  sin  02 

C2  Cj 


(1) 


These  equations  nay  be  expressed  in  terais  of  the  ray-path  parameter,  p, 
as  a  nonlinear  equation  given  by 


_ _ -  + _ - 

~  -2  o'  ~ V “  “a 

/C2  ^  -  p-  /Cl  "  -  p" 


(E-56 ) 


for  0  <  p  <  l/c2  • 


For  a  prescribed  source-detector  position,  Equi^ion  (E-56)  must  be 
Solved  numerically  for  the  ray  parameter,  p.  In  this  way  the  pair  of  angles 
t>f  incidence  [di'^A  92^^^J  may  be  determined  and  sub-.titutej  in  Equation 
(E-54)  to  obtain  the  arrival  times,  t^j,  for  J.  =  0,1,2,...  N. 

Iraplenenting  the  first-motion  approxi  mat  ion  in  Eqmtion  (E-51),  the 
SH-wave  displacement,  uiCt),  becomes 


ui(t)  V 


N 

-T  I 


L  „  f  ' 

- Rel - 

—  - -  *-  W.  < 


R*(pjt  )T(pi) 


2irp2C22  j2  =  i  /(2Sji)  '^2(P4>  /(t-t^) 


where : 


(E-57) 


(x<;-h)  h(2t  +  l) 

3  y  *  ~  3  2 

02  C2  ai-’ci 


E-17 


FIGURE  E-3.  GEOMETRY  OF  Sll-WAVE  RAY  PATHS  FROM  A  LINE  SOURCE  IN  THE  BEDROCK 
LAYER  TO  A  DKTECrOR  AT  THE  SURFACE  SHOWING  THE  CONTRIBUTIONS  ASSOCIATED 
WITH  THE  POWER  SERIES  EXPANSION  OF  EQUATION  (E-51 ) 


E-18 


aiiil 


PI 


sin  0 


(U 


ct 


For  a  transient  Sti-wave  pulse  acting  along  the  z-axis  parallel  to  the 
cylindrical  cavity  and  consisting  of  a  body  force,  f(t),  the  transient  Sll-wavo 
displaceraent  is  obtained  by  convolution;  that  is. 


ui(t)  = - (f(t)  *  Ti(i)(t)) 

2710  2*^2“^ 


(E-58) 


and  its  time  derivative  is 


dui  (t ) 

dt 


_ I  _  d_ 

27xp2C2^ 


(f(t) 


*  Ti(0(t)] 


(E-59) 


whe  re ; 


Tl 


(i)  = 


N 

^2  I 

.1-0 


/s 


_ 1 _ 

P=P,1  ''(t-to) 


(E-60) 


APPENDIX  F 

ASYMPTOTIC  S0LI.:T[()S  OF  THF  INTFCRAL 


APPENDIX  F 


^_yn[)CotJ:C _ SoJjij.  ion  oj  tho  Integral  Qiii.i 


Making  the  substitution  X  =  k.2  sin  G  in  the  integral  given  by 

Equation  (110a)  leads  to 


Qnn,  =  (-j)""-^/„£l(a)ej^2(2H-h-x)  cos  9-jO(n+n,)^Q 


X  j•gjk2a(^)(x+h)  ^  ^j'K.2aO  )(h-x)  j  (F-l) 


where  the  integration  path  V  is  shown  in  Figure  (D-1)  and  t^O)  is  given  by 


eiO) 


_ T(e) 

1  -  R(9)Vj’2*^2ha(8)  > 


(F-2) 


in  which 


R(o)  =  ; 

C2a(9)  +  cos  9 


TO)  =  —  . 

Q^a(O)  +  cos  9 


and 


i(9)  =  (v2  -  sin29)l/2  ; 

O 

=  hi/m.2  ; 

V  =  ki/k.2  • 


was  done  in  Appendix  D,  the  asymptotic  solution  of  the  integral  nay  be 

^erived  using  the  saddle-point  method.  To  obtain  an  appropriate  form  of  the 
^tegral  given  in  Equation  (F-l)  and  to  remove  the  singularities,  the  inte- 
8tand,  € j (9 ) ,  may  be  expanded  in  the  power  series 


ei(9)  =  T(0)  I  R^(9)e^-5'^2’T^^ 
Jl=0 


F-l 


(F-3) 


whf  re  ; 


a  =  a(0)  =  (v^  -  -,in^0)^/2  , 

Equation  (F-1)  may  be  express  as 

Qnra  ~  Qnm  ^nn  (-"-A) 

vhe  re : 

Qnm  =  I  T(e)R(0)J^ej’^2(2n-h-x)[g+(6)  +  cos  0]^g^j0(nfm)  (r_5;, 

and 

Qnm  =  I  T(0)R(0)^e2’^2(2H-h-x)[g  (0)  +  cos  0  ]  9  (n+m) 

’'a=o  r 


in  which 


and 

^-fa\  _  a(h-x+2?h) 

S  ':H-h-x 

For  a  detector  located  at  the  surface  (x  =  0) 

g(0)  =  g'^CO)  =  g~(0)  =  ;  X  ■«■  0  (F-:; 

and  the  integral  is  reduced  to 

Qnrn  =  ("j)"''"'-!  /  T(0  )R-^e  2*^2  ( 2H-h  )[  g  (0  )  +  cos  eJ^g^jeCn+m)  .  (p.g) 

^Jl=0  ^ 

To  solve  the  integral  using  the  saddle  point  method,  the  following  inte¬ 

gral  is  considcied. 


F-2 


(F-9) 


r 


+  j9(n+iii) 

ub 


which  has  the  general  form  given  by 


1}  =  /  F(9)e’1"(9  )d8 

r 


(F-10) 


whe  re ; 


r)  =  kj(2H-h)  : 


f  (9 )  =  j[g(9)  +  cos  6)  =  j(  cos  9  +  cjiot)  ; 
F(0)  =  T(e)R^(9)ei®("+'"^  ; 


and 


(ZH-t-l  )h 
2H-h' 


The  saddle  point,  9q,  is  determined  from 


d0 


(cos  0  +  ejja  (9  )) 


0 


which  gives 


9  =  nir;  for  n  =  O.tl.tZ,... 


Since  the  saddle  point  must  be  within  the  interval  -'^/2  <  0q  <  ^!1,  then  9^^ 
®ust  be  equal  to  zero.  Equation  (E-IO),  as  solved  by  the  saddle-point  method, 
the  form 


=  F(0o)e" 


f(9o)  fl\ 

/  -qf” 


(1 


f-- 

t-  f ' 


LI 

F 


i  ilL  L  il'  'JL>’  -11- 

4  f"  '12  (f  ••)2  '  F 


^  • 


(F-1  I  ) 


The  functions  F  and  f  and  their  derivatives  are  evaluated  at  0^ 
functions  are  given  by 


0. 


F(0)  =  -  2 - 

C^v  +  1  +  1 


u  f  I 

(-^)  ■  I 


(I  -  c2v)(l  +  c^v)  I  +  c2 


f  (0  )  =  j  (  1  +  ) 


f  '  ’(0)  =  -j(l  +  c-fv) 


(111] 

I  f  I 


1  +  —  ejj^(  1  -  3/4v^ ) 
1  + 


Thus,  the  asymptotic  solution  of  the  integral  is 


I,  =  T  R^b?  _ _  jk2(2H-h)  +  jk2(2i  +  l)hv  -  t  j 

I  ^  k2(2H-h)  +  k2(2)l+l)hv 


X  1  + 


2k2(2H-h)  +  2k.2 


(24  +  1  )h  i-  4 


Tlh  +  T2] 


°  "  C  2  V  +  1  ’ 


r27  +  I  ’ 


}-  ±  ±1 J -h ) 

1  +  (24+1)  ~/(2H-h) 

V 


r 


00=0 


and 


^2  = 


^  F  J 


00=0 


Finally,  replacing  the  asymptotic  solution  of  the  integral  in  Equation 


(F-6)  leads  to  the  asymptotic  solution  of  Che  integral,  Qom' 


0.  That  is, 


<nai 


r  A  1 

=  2  I  b^ToRo  - 


Jl=0 


71  /  k2(2H-h)  +  k2(2Z  +  l)hv 


_  ^j{k2[(2H-h)  +  (2i+l)hv]  ~  ^  ~  (n+m)f 


X 


fi  + - - f— -1[t  Ti+r2] 

L  2(k2[2H-hM2Ul>5]U  - 


(F-U) 


In  the  high-frequency  limit  as  2k2(2H-h)  +  the  approxim.ite  solution  for  the 
function  Qo,^  nay  be  obtained 


Qnm  ^  2  1  b4ToR5Ho+,„{k2i  (2H-h)  +  (l+2i)hv]} 

1=0 


(F-15) 


.it.._J5iSRSr-'«.‘^ 
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APPENDIX  G 

Synthetic  Seisnu^rams  of  SH-«'ave  Reflections  from  a  Cylindrical  Cavity 
In  a  Two -La yer  Lo ss^  Half  Space 


The  synthetic  seismograms  presented  in  this  appendix  highlight  the  impor 
tant  case  in  which  Che  medium  is  represented  as  a  two-layer  medium  containing  a 
cylindrical  cavity  target  in  the  lower  (bedrock)  medium.  The  surface  layer 
represents  Che  weathered  layer  and  is  typified  in  the  model  as  a  relatively  low 
velocity  unconsolidated  soil.  The  constitutive  parameters  of  SH-wave  velocities 
and  the  mass  densities  of  each  layer  are  maintained  essentially  the  same  in  all 
of  the  computed  cases,  whereas  the  2-!neter  diameter  cavity  depth,  the  surface 
layer  thickness,  and  the  absorptive  characteristics  (Q  factor)  of  each  layer  are 
the  variables.  For  convenient  reference,  the  various  parameters  associated  with 
each  synthetic  seismogram  are  tabulated  in  Table  G-1. 


TABLE  G-1 

LIST  OF  PARAMETERS  USED  IN  LOSSY  TWO-LAYER  MODEL  COMPUTATiONS 


Figure 

Cylindrical 

Surface 

Surface 

Seismic 

Surface 

Reflections  in 

No. 

Cavity 

Layer 

Layer 

Detector 

Layer 

Surface  Layer 

Depth 

Thickness 

Q  Factor 

Locat ion 

SH  Velocity 

Direct 

Cav  i.  c  y 

(m) 

(m) 

(m/s ) 

Wave 

Ref lect  Lon 

G-1 

50 

5 

50 

Bedrock 

200 

0 

1 

G-2 

50 

10 

50 

Bedrock 

200 

0 

1 

G-3 

50 

5 

10 

Bed  rock 

200 

0 

1 

G-4 

50 

10 

10 

Bed  rocV 

200 

0 

1 

G-5 

100 

5 

50 

Bedrock 

200 

0 

1 

G-6 

100 

10 

50 

Bed  rock 

200 

0 

1 

G-7 

100 

5 

10 

Bed  r  ock 

200 

0 

1 

G-8 

100 

10 

10 

Bed  rock 

200 

0 

1 

G-9 

50 

5 

50 

Sur  face 

200 

0 

1 

G-10 

50 

10 

50 

Surf  ace 

200 

0 

1 

G-n 

50 

5 

10 

Surface 

200 

0 

1 

G-1 2 

50 

10 

10 

Surface 

200 

0 

1 

G-13 

100 

5 

50 

Surface 

200 

0 

1 

G-U 

100 

10 

50 

Surface 

200 

0 

1 

G-15 

100 

5 

10 

Surface 

200 

0 

1 

G*'  *  f) 

100 

10 

10 

Surface 

200 

0 

1 

C-17 

50 

5 

50 

Bed  rock 

500 

0 

1 

0-18 

50 

5 

50 

Bedrock 

500 

1 

9 

0-19 

50 

5 

50 

Bed  rock 

500 

2 

3 

0-20 

50 

5 

50 

Bed  rock 

500 

3 

TABLE  G-1  (Cont'd) 


Figure  Cylindrical 
No.  Cavity 
Depth 
(m) 


Surface  Surface  Seismic  Surface  Reflections  in  | 

Layer  Layer  Detector  Layer  Surface  Layer  i 

Thickness  Q  Factor  Location  SH  Velocity  Di rec t [  Cavity  | 
(m)  _  _  (n/s )  Wave  [Reflection 


Surface 
Surface 
Surf  ace 
Surface 


Invariant  Parameters: 


Surface  Layer  Mass  Density  =  Pl  =  1,500  kg/m"’ 
Bedrock  Q  Factor  =  100 
Bedrock  SH-Wave  Velocity  =  2,500  m/s 
Bedrock  Mass  Density  =  P2  “  2,700  kg/m^ 

Source  Located  in  Bedrock 
Detector  Separation  Distance  =  2  m 
Cylindrical  Cavity  Diameter  =  2  m 
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IN  THK  BKliHOr.K  ,  AM',)  niK  AKKAY  OF  DF.TFC- 
TORS  HAVINt;  A  DFTKCTiJR  Si’ACING  OF  2-m  I: 
LOCATKl)  AT  TIIK  SlII'FArK  OF  THF  F.ARTM. 


APH::;:iDix  h 
Co'n[ui:.or  Pro^'ran-^ 

H .  1  ?  i a ne__'.'.'a'.a:'  a  tj; e  r  i 

The  programs  ia  this  Section  H. 1  model  the  scattering  of  plane  SH  waves 
from  a  cylindrical  cavity  in  a  homogeneous  lossUess  whole-space  as  a  fun  tio 
of  frequency.  All  computational  pregrams  are  written  in  FORTRAN  77  language 
The  graphics  programs  of  Section  H. 3  are  writt-n  in  C  language. 

H.  1 . 1  Energy  Scatterjmtg^  Cross-Section  Program 

C 
C 
C 
C 
C 
C 
C 
C 

c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 

sali 

SALLaS  jn  =  'jn'  (,Tval,  Zval) 

AS  yn  =  'yn'  (Zval,  Zvil) 

program  cs->cr 

i mp 1 i e  i  t  nonu 

lnte,',‘r*-'4  stlin,  stdout,  stderr 


Program  :  csect 

Author  :  J.C.  Biard 

Discussion  :  The  program  csect  calcn.lates  the  total  energy-scattering 

cross-section  as  expressed  by  Equation  (37)  in  Volume  I  as  a  function 

of  frequency  for  a  cylindrical  cavity  of  radius,  a,  illuminated  by  a 
plane  SH  wave  in  a  homogeneous  whole  space.  The  cross-section  is 
reported  as  a  function  of  wavenumber  multiplied  by  the  tunnel  radius. 
The  summation  of  the  contribut ions  made  by  the  different  scattering 
modes  is  computed  to  an  accuracy  of  O.Ol  percent  of  the  value. 

Invijcation  :  The  program  is  invoked  by  typing 

csect  >  ofile 

where  ofile  is  the  output  filename. 

Formal  Argumen.ts  ;  none 

Procedures  called  from  this  mod  ■  ’ e  ; 

jn  Bessel  function  of  the  first  kind.  (HP-L'X  utility.) 

yn  Bessi.'l  function  of  the  second  kind.  (HP-UX  utility. 

External  Vari.ibles  :  none 


H-l 


j,  k,  1,  n,  n 

real*8  sect,  ka ,  x,  acc 

compl  .::x*  1  6  a  j  ,  i 

real*8  jn,  yn ,  re,  im 

data  stdin,  stdout,  stderr  /  5,  6,  6/ 


C 

C  Define  stateraent  functions  for  the  real  and  imaginary  parts  of  the 
C  contribution  terras. 

C 

re(n,  x)  =  n  *  jn(n,  x)  -  x  *  jn((n+l),  x) 
ira(n,  x)  =  n  *  yn(n,  x)  -  x  *  yn((n+l),  x) 

i  =  cmplxCO. ,  1 .  ) 

C 

C  Explicitly  write  tlie  zero  firipjency  cross  -sect  ion  value. 

C 

sect  =  0. 
ka  =  0. 
n  =  0 
acc  =  0. 

wr i t e ( s t dout ,  2000)  ka,  sect,  n,  acc 
C 

C  For  ka  =  .05  to  2.  by  .05,  calculate  the  cross-section. 

C 

do  k  =  1 ,  ^0 
:  =  0 

ka  =  k  *  .05 
C 

C  Get  t!'-e  mode  ccint  r  i  but  i on  term  for  j  =  0. 

C 

aj  =  -dcr.plxC  re(  j  ,  ka))  /  dcmplx{re(j,  ka),  ira(j,  ka  ) ) 
sect  =  real (a j  *  conjg(aj)) 

C 

C  Loop  ver  j  to  sura  the  contributions. 


C  Get  th.e  jth  contribution  to  the  cross-section. 

C 

aj  =  ilcnipl  x(  re(  j  ,  ka))  /  dcmpl  x(  ro  ( j  ,  ka),  imC  j  ,  ka  ) ) 
X  =  2.  *  real(aj  *  conjg(aj)) 

C 

C  Galculate  the  accuracy  ti-st  value  and  add  the  new  term  to  the 
C  sum  for  the  cross-section. 

C 

acc  abs(x  /  sect) 
sect  ■  s  ( .'  I  r  +  X 


H-2 


c 

c 

c 

c 


c 

c 

c 

c 

c 

c 


c 

c 

c 


c 

c 

c 


c 

c 

c 


c 

c 

c 

c 

c 

c 

c 

c 

c 

c 


c 

c 

c 

c 


If  the  sum  V-iS  It  least  15  teriiis  and  the  aceuracy  is  in  limits,  thtui 
stop  the  su;:; . 

if  (j  .ge.  15  .and.  acc  .le.  .0001)  go  to  10 
end  do 

10  continue 

Multiply  the  cross-section  sum  by  constant  terms, 
sect  =  sect  *  2.  /  ka 

If  the  accuracy  is  out  of  limits  then  write  an  error  message. 

if  (ace  .gt.  .0001)  then 
write(stderr  ,  2001  ) 
end  if 

Write  the  results  to  the  standard  output. 

write(stdout ,  2000)  ka ,  sect,  n,  acc 
end  do 

For  ka  =2.1  to  10.  by  .1,  calculate  the  cross-sect  ion. 

do  k  =  0,  80 
j  =  0 

ka  =  2 .  +  k  *  .  1 

Get  the  mode  contribution  term  for  j  =  0. 

aj  =  -Jcmply.(re(  j  ,  ka  ) )  /  dcmpl'<(  re(  j  ,  ka),  im(j  ,  ka)) 
sect  =  real(aj  *  conjg(aj)) 

Loop  over  j  to  sum  the  contributions. 

do  j  =  1,  50 

Get  the  jth  contribution  to  the  cross-section. 

aj  =  demp  1  :<  (  re  ( j  ,  ka))  /  dcmplx(re(j,  ka),  im(  j  ,  ka)) 

X  =  2.  *  real(aj  *  conjg(aj)) 

f-alculate  the  accuracy  test  value  and  add  the  new  terra  to  the 
sura  for  the  cross-scct ion. 

acc  =  abs(x  /  sect) 
sect  =  sect  +  x 
n  =  j 

^f  the  sura  has  at  least  15  terras  and  the  accuracy  is  in  limits,  then 
stop  the  sura. 


ooonononnooooorionoo  n:  3:  noo  00 


if  (j  .gc.  15  .and.  acc  .le.  .0001)  go  to  20 
end  do 

20  continue 
C 

C  Multiply  tlie  cross-section  sum  by  constant  terms. 

C 

sect  =  sect  *  2,  /  ka 
C 

If  the  accuracy  is  out  of  limits  then  write  an  error  message. 

if  (acc  .gt.  .0001)  then 
wr i te ( St der r  ,  2001  ) 
end  if 


Write  the  results  to  the  standard  output. 

wri teCstdout ,  2000)  ka ,  sect,  n,  acc 
end  do 


Stop 

2000  forraatC'ka,  sect, 

1  g20.10,  ", 

2001  f orma t ( "+ + t 


n,  acc  =  ", 


",  g20.10,",  ",  i20,",  ",  g20.10) 

Not  in  accuracy  limits  +++  +  ■*-+ 1+ i' -n-" ) 


end 


.1.2  D i  sp__l  a c  em_e n_t  Amj> l^i  uui e  Pro g_r  a 
.1.2.1  d  i  s_p_a 


Program  :  dispa 

Author  :  J.C.  hie,  rd 


Discu‘’ston  :  This  pro,grara  calculates  the  total  disnlacer.ent  field  as 

expressed  by  '‘piation  (2b)  in  Volune  I  vat  the  '-■■.rface  of  a  v-ylinirioal 
cavity  of  radios  a  for  an  incident  pl.ino  Sll-wave  of  unit  amplitude  with 
wave  number  k. 

The  results  are  given  as  the  relative  amplitude  and  pha-.e  at  A5,  90,  and 
135  degrc'i's  for  values  of  k  between  0.  vtnd  10. 


Invoi.ation  :  The  prc)grain  is  invoked  by  typing 
dispa  >  ofile 

where  ofile  is  the  oui  put  filon.ime. 

C  Formal  Argum'uits  :  none 


11-4 


C  Procedures  called  fri^i;i  this  module  : 

C  plane_scac Ce r  Subroutine  that  calculates  the  di 

C  amplitude. 

C 

C  External  Variables  :  none 
C 


prog  ran  di spa 
implicit  none 

integer*-4  stdin,  stdout  ,  stderr 
integer*-!  k,  n 

real*8  amp,  phase,  phi,  phiO,  phiend,  ka ,  kr,  acc ,  pi 

real*8  oldphase,  offset,  phasem.ix,  accl,  kre 

conplex*l6  dsp 
charact-T*l  ff 

data  stdin,  stdout,  stderr  /  5,  6,  6/ 
data  pi  /  3.1A15926533897/ 
data  acc  /  .0001/ 


ff  =  char (12) 

Set  the  angle  limits  and  step. 

phiO  =  45.  *  pi  /  180. 
phiend  =  3.  *  phiO 
phasenax  =  7.  *  pi  /  ■!. 

Loo;  over  the  angles  of  interest. 

do  phi  =  phiO,  phiend,  phiO 
wr  i  te  ( stdout  ,  2Oi)0  )  ff,  phi 
offset  =0. 
old  phase  =  0. 

Calculata  values  for  0.  '  =  ka  <=  2.,  stepping  by  .*15. 

do  ka  =  0. ,  2.01 ,  .05 
kr  =  ka 

Get  scattered  field  value. 

call  plane_sc  It lerCacc ,  ka ,  kr,  phi,  n,  accl,  dsp) 
Add  incident  field  term, 
kre  =  kr  *  cos (phi  ) 

dsp  dsp  demp  1  x(  cos  (kre  ) ,  sin(krc)) 


M 


onn  non  ono  ooo  ooo  or;o  on 


C 

C  Find  .impl  i  t  ude  and  phase. 

C 

arap  =  ahs(dsp) 

phase  =  da t an2 (d iraag (dsp ) ,  dble(dsp)) 

C 

C  If  phase  has  wrapped  around  the  ISO  or  360  deg.  point,  unwrap  i 

C 

if  (abs(oldphase  -  phase)  .gt.  phaseraax)  then 
offset  =  offset  -  slgn(2.*pi,  phase) 
end  i f 

oldphase  =  p)iase 
phase  =  phase  t  offset  -  krc 
C 

Write  out  results. 

wri  te(stdout  ,  2001  )  n,  ka ,  imp,  f^hase,  accl 
end  do 

Calculate  values  for  2.1  <=  ka  <=  10.,  stepping  by  .1. 

do  ka  =2.1,  10.01 ,  . 1 
kr  =  ka 

Get  scattered  field  value. 

call  pi  ine_scat terfarc ,  ka ,  kr,  phi,  n,  accl,  dsp) 

Add  incident  field  t-.-rm. 
krc  =  kr  *  cos (phi) 

dsp  =  dsp  +  dcirp  1  x(  COS  ( k  rc  ) ,  sin(krc)) 

Find  amplitude  and  phase, 
amp  =  abs(dsp) 

phase  =  da  t  .in2  (d  i  ;r,,ag,  (dsp  ) ,  dble(dsp)) 

If  phas(>  h.'is  wrapped  areumd  the  130  or  360  deg.  point,  unwrap  i 

if  (abs  (aldphase  -  ph.ise)  .gl  .  pha  \ )  then 

offset  =  offset  -  sign (2.* pi,  phase) 
end  if 

oldi)hase  =  phase 
phase  -  phase  +  offset  -  krc 

Write  out  results. 

wri te(st dout ,  2001)  n,  ka,  amp,  phase,  accl 

end  do 
'■  n d  do 


s'  (ip 


a  c'i  C) 


2000  f  ori'.a  t  ( 1  , 


1 


//  t2, 


2001  for''.ut(iA, 


"SH  An^il  it'id-'  and  Pha  . a  at 
"n",  tlT.  "ka",  t35,  "an'/' 
"  ",  gOO.LO,  "  ",  g20.10." 


r  =  a,  ",  "phi 
c3-*,  "piia;..", 
",  g20.10,"  ", 


t7h 

p,--o 


.'20.  10 
"acc"/ ) 
10) 


H.  1.2.2  disj'b 
C 

C  Progrj")  ;  dispb 

•Author  :  J.C.  Biard 


C 

C 

C 

C 

C 

C 

C 

C 

C 

C 

C 

C 

C 

C 

c 

c 

c 

c 

c 

c 

c 

c 


Discussion  :  This  progtim  calculates  the  total  d  i  spl  ai-e:a»;ui  t  field  for  the 
scattering  of  a  plane  S!l-wjve  from  a  cylindrical  cavity  or  r.id.ius,  a, 
at  3  wave  number  of  ka. 

The  field  is  determined  at  a  variety  of  distances  froi.-,  the  cvlind-r 
and  at  angles  to  the  incident  wave  prup.agitian  vector  of  -ai,  9i} ,  a-',  i  111 
degrees.  "he  wave  number  also  takes  on  valu"‘S  of  .3,  1.,  ai' 1  2. 

Invocation  :  The  program  is  invoked  by  typing 


di spb  >  of i le 


where  ofile  is  the  outp\it  filr  i-v. 
Form.il  Argime:’, t  s  :  none 
Procedu  rt.  s  called  from  this  au,'.  1  •>  ; 


plane  sritt-'r 


Suhrou.t  i  ne  tl 

anp  1  i  tv.,;.. . 


d  ’  s  1  a.-r 


t-.tt-’r:',al  Variables  :  none 


pro.;  ra,.T  di 

spb 

implicit  non. 

intege  r  *-4 

s  t  d  i  n 

i  n  t  e  ;.t  t,'  r  *  a 

k,  n. 

real *8 

amp , 

real *8 

roa  , 

compl. ■:<*!'') 

dsp 

chara cter* 

1  ff 

,  stdout  , 
nka 

phi ,  phiO 
accl,  krc 


s  t  d  e  r  r 


ph i end  , 
kas (  1 ) 


ka 


kr  , 


<3C  C  , 


pi 


non  non  non  non  on 


J.iCa  sidin,  strfout,  stdorr  /  5,  6,  6/ 
data  pi  /  d . 1  A  1 b9:6S  3 5897 / 
data  nka,  kas  /  3,  .5,  1.,  2./ 
data  acc  /  .0001/ 

ff  =  c!iar(12) 

C 

C  Set  the  angle  limits  and  step. 

C 

phiO  =  A5.  *  pi  /  180. 
phiend  =  3.  *  phiO 

C 

C  Loop  over  the  angles. 

C 

do  phi  =  phiO,  phiend,  phiO 
C 

Loop  over  the  ka  values. 

do  k  =  1 ,  nka 
ka  =  k..,s(k) 

wr i te ( St dout ,  2000)  ka ,  phi 

Loop  over  1.  <=  r/a  <=  10,,  stepping  by  .5. 

do  roa  =  1 . ,  10.,  .5 
kr  =  roa  *  ka 

Get  scatlt>red  field  value. 

call  plane_scat ter (acc ,  ka ,  kr ,  phi,  n,  accl,  dsp) 
Add  incident  field  term. 

krc  =  kr  *  cos(phi) 

dsp  -  dsp  +  dcmpl x( cos (krc  )  ,  sin(krc)) 

Find  .itipli  tilde. 

anp  -  ah'!  (dsp) 

C 

C  Wri 1 e  out  resul ts. 

C 

writo(stdoiit  ,  ZO'il)  n,  roa,  ki  ,  amp,  accl 
e n d  do 
C 

C  I.Hjp  >ver  '1.  <=  r/a  <=  50.,  stepping  by  1. 

C 

do  roa  =  II.,  50. ,  I . 
kr  -  roa  *  ka 
C 

C  Get  seal lered  field  value. 

C 

call  plane  scalter(acc,  ka,  kr ,  phi,  n,  accl,  dsp) 
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C 

C 

c 


c 

c 

c 

c 

c 

c 


Add  incident  field  terra. 

krc  =  kr  *  co-.  (phi) 

dsn  =  dsp  +  dcrnplx(  cos  (krc  )  ,  sin(krc)) 
Find  arapl i t nde  , 

amp  =  abs(dsp) 

Write  out  results. 


wr  i  te  (  stdout  ,  2utJl)  n,  roa,  kr,  amp,  acc  1 
end  do 
end  do 
end  do 


2000  formatCal,  "Displacement  Anplitude,  ka  =  ",  ^20,  10,  "phi  =  "  s'’0  M 

I  /  /  .  s  II  ^  -  II  I  II  .  , ,  „  >  6  - 


1  //  t2, 

2001  forraat(i4. 


■n",  cl5,  "r'a",  c3h,  "kr",  c54,  "anp" ,  tZb,  "acc"/) 
'  g20.10,  "  ",  g20.l0,"  ",  g20.10,”  ",  g20.10) 


H. 1 , 2 . 3  dispcd 
C 

C  Program  :  dispcd 

C 

c  Author  :  J.C.  BiarJ 

C 

Discussion  :  This  program  calculates  the  araplitude  of  the  displ  v'emen.t 
field  as  expressed  by  Fqujtion  (26)  in  Volume  I  as  a  function  of  angl. 
for  the  scattering  of  a  plane  SU-wave  from  a  cylindrical  cavity  of 
r  a  d  i  Li  s  a . 

The  values  are  determined  for  a  number  of  cases  of  radial 
distance  from  the  cylinder  center  and  for  a  number  of  values  of  the 
wave  number. 

An  option  is  provided  in  the  code  where  it  is  possible  to  comment 
out  a  section  and  obtain  the  scattered  field  only. 

Invocation  ;  The  program  is  invoked  by  typing 


C 

c 

c 


dispcd  >  ofile 

where  ofile  is  the  output  filename. 
Formal  Arguments  :  none 


!1  ') 


■r 


C 

C 

c 

c 

c 

c 

c 


Proceduies  cilled  from  this  n-;.iiule  : 


plane_sca;.  ter 


Subroutine  that 
displacer, L-nt 


calculates 
anpl i t  ade  . 


the 


External  Variables  :  none 


program  dispcd 

implicit  none 

integer*^ 

stdin,  stdout,  stderr 

i nteger*^ 

k,  m,  n,  nka,  nra 

real *8 

amp,  phi,  phiO,  ka,  kr ,  arc 

real*8 

r-'a,  ra(lO),  krc,  kas(lO) 

canpli.-x*16 

dsp 

character*!  ff 

data  stdin 

,  stdout,  stderr  /  5,  6,  6/ 

data  pi  / 

3.  141  5926535897/ 

data  nka, 

kas  /  3,  .5,  1.,  2./ 

data  nra. 

ra  /  7,  1.,  2.,  5.,  10.,  20. 

data  jcc  / 

,0001/ 

ff  =  ohar(12) 
phiO  =  pi  /  180. 


C 

C  Loop  over  the  r.'a. 

C 

do  k  =  1 ,  nra 
roa  =  ra(k) 

C 

C  Find  the  ka  and  kr  values. 

C 

do  n  =  I ,  nka 
K  3  —  K.JsCtn). 
k  r  =  roa  *  ka 

wi  i  te(st  dout  ,  .1000)  ff,  ka  ,  roa 

C 

C  I.oop  over  the  -ingles. 

C 

do  phi  =0.,  pi,  phiO 
C 

C  Get  sc.attered  field  value. 

C 

call  plane_sc.iLter(arc,  ka ,  kr,  phi,  n,  acrl,  dsp) 

C 

C  Add  ini’ident  field  term. 

C  ff  the  following  two  lines  are  oonm.nled,  the  scattered  fie 

C  wi 1 1  be  described. 

C 


I 


A 


Id  only 
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krc  =  kr  *  cos (phi  ) 

dsp  dsp  +  dcinpl>c(cos(krc),  sin(krc)) 

C 

C  Find  amplitude 

C 

amp  =  abs(dsp) 

C 

C  Write  out  results. 

C 

wr i t e ( s tdou t ,  2001)  n,  phi,  amp,  accl 
end  do 
end  do 
end  do 

stop 

2000  for-iat(al, "Displacement,  ka  =  ",  g20.10,  "r/ •  =  ",  g20.10 

1  //  t2,  "n",  tl5,  "phi",  t35,  "amp",  t5A,  "acc"/) 

2001  foniat(i4,  "  ",  g20.10,  "  ",  gOO.lO,"  ",  g20.l0) 

end 


H .  1 . 2 .  A  ^  sj)  0 


C 

C 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 


Program  :  dispe 

Author  :  J.C.  Biard 

Discussion  :  This  progra-i  calculates  the  amplitude  of  the  displacenont 
field  as  expressed  by  t<iuation  (2o)  in  Volume  I  from  a  plane  SH-i.'ave  of 
unit  amplitude  incident  on  a  cylindrical  cavity  of  radius,  a,  and  at  a 
wave  number  of  k. 

The  values  are  determined  along  the  x-axis  at  intervals  of  dxl  for  a 
cylinder  located  at  x=0.  and  y  =  -h,  and  for  an  incident  wave  whose 
propagation  vector  maV.es  an  angle  -theta  with  '  h,e  negative  y-axis. 

The  propagation  vector  makes  an  angle  of  th<  ta  with  the  y-axis. 

In  this  example,  the  propagat ion  v-u’tor  is  parallel  to  a  line  from 
(-dx,  0.)  to  (0.,  -h). 

The  point  (-dx,  0.)  is  the  shot  point  for  seismic  exploration  work. 

The  program  also  contains  an  option  to  set  the  angle  theta 
independently  of  the  position  dx. 

Invocation  :  The  program  is  invoked  by  typing 

dispe  >  of i le 

where  ofile'  is  the  output  filena-.e. 
formal  Arguments  : 


none 


C  Proct'diires  called  from  tliis  rnodule  ; 

C 

C  plane_scat rer  Subroutine  that  calculates  the 

C  displacement  amplitude. 

C 

C  External  Variables  :  none 
C 

program  dispe 
implicit  none 

integer*4  stdin,  stdout,  stderr 
integer *4  k,  m,  n,  nh,  nka 

real*8  camp,  phase,  phi,  ka,  kr,  acc ,  pi,  hoa(lO),  accl, 

real*8  oldphase,  offset,  phasemax,  xl  ,  h,  a,  dxl,  the  ta 

real*8  kas( 10) 

complex* 16  dsp 
character*!  ff 

data  stdin,  stdout,  stderr  /  5,  6,  6/ 

data  pi  /  3. 1415926535897/ 

data  nka,  kas  /  3,  .5,  1.,  2.,  7*0./ 

C  data  nh,  hoa  /  5,  2.,  5.,  10.,  20.,  50.,  5*0./ 

data  nh,  hoa  /  5,  20.,  40.,  60.,  80.,  100.,  5*0./ 

C  data  nh,  hoa  /  5,  5.,  10.,  15.,  20.,  25.,  5*0./ 

data  a,  dxl,  dx  /  1.,  .5,  54./ 
data  acc  /  .0001/ 

ff  =  char(12) 

C 

C  Set  the  value  of  theta.  (Not  in  use  now.) 

C 

C  theta  =  pi  /  2.  (For  parallel  to  ground  case.) 

C  theta  =  pi  (For  holo-to-hole  case.) 

C 

C  Loop  over  the  depths. 

C 

do  k  =  1  ,  nh 

h=ha(k)*a 

C 

C  Find  the  "source  point"  angle  theta. 

C  .  oinnent  out  this  line  when  using  a  presi't  iheta  value. 

C 

th.eta  dat.in2(dx,  h) 

C 

C  Loop  over  the  values  of  ka . 

C 

do  m  =  1 ,  nka 
ka  '  k.as(m) 

wi  i  t  e  (  St  dniit  ,  2000)  ff,  ka  ,  h 
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xrc 

dx 


o  o  o  o  o  n  o 


C  Loop  over  the  points  on  the  detector  line. 

C 

do  xl  =  -50.,  50.,  dxl 
C 

C  Calcul.^ite  the  kr  and  phi  values. 

C 

kr  =  ka  *  sqrt(h**2  +  xl**2)  /  a 
phi  =  datan2(h,  xl )  +  pi  /  2.  -  theta 
C 

C  Get  scatter^  ■!  field  value. 

C 

call  plane__scatter(.acc ,  ka ,  kr ,  phi,  n, 

C 

C  Add  incident  field  term. 

C 

krc  =  kr  *  cos(phi ) 

dsp  =  dsn  +  dcrnplx(c03(krc) ,  sin(krc)) 

C 

C  Find  amplitude  and  phase. 

C 

amp  =  abs(dsp) 

C  phase  -  da:an2(dimag(dsp) ,  dble(dsp)) 

C 

If  phase  has  wrapped  around  the  130  or  360  deg. 


C 

C 

c 


if  (abs(oldphase  -  phase)  .gt.  phaseaax) 
offset  =  offset  -  sigri(2,*pi,  phase) 
end  i  f 

oldphase  =  phase 

phase  =  phase  +  offset  -  ka  *  cos(phi) 
Write  out  results. 

write(stdout ,  20()l)  n,  xl,  amp,  accl 
end  do 
end  do 
end  do 


stop 


2000  format(al, 

,  1  //  t4, 

2001  format(i4, 


"Displ ice meat , 
"n",  tl5,  "xl", 

"  ",  g20.10,  " 


ka  =  ",  g20.10,  "h  =  ", 
t35,  "amp",  t54,  "acc" 
",  g20.l0,"  ",  g20.10) 


accl,  dsp) 


point,  unwrap  i 
then 


g20.  10 

/) 


o  n 


H.  1.2.5  pj^ane-seat  ter  Si.ibroutir^ 

C 

C  Procedure  nane  :  plane  scatter 

C  “ 

C  Author  :  J.C.  Biard 

C 

C  Discussion  :  This  subroutine  calculates  the  scattered  displaceir.ent 
C  field  as  expressed  by  Equation  (25)  in  Volune  I  for  a  unit  amplitude 

C  plane  SH-\.'ave  incident  on  a  cylindrical  cavity  buried  in  a 

C  whole-space. 

C 

C  The  input  arguments  ar^: 

C 

C  acc  The  fractional  accuracy  level  used  in  the  convergence  test. 

C  a  The  wave  number  multiplied  by  the  cylinder  radius. 

C  kr  The  wave  number  imiltiplied  by  the  obS'^rvation  point  radial 

C  distance  from  '.he  center  of  the  cylinder. 

C  phi  The  angular  position  of  the  observation  point  relative  to 

the  plane  wave  propagation  vector. 

C  The  output  arguments  are: 

C 

C  n  The  number  of  terms  used  in  the  summation.  If  conve rgc-nce 

C  is  not  reached  in  50  terms,  n  is  negative. 

C  accl  The  fractional  accuracy  at  convergence  (minimum  15  terms) 

C  or  the  fractional  accuracy  at  the  end  of  50  terras. 

C  dsp  The  complex  displacement  field  at  the  point  (r,  phi). 

C 

C  External  Variables  :  none 
C 

C  Procedures  called  from  this  module  : 

C 

C  jn  Bessel  function  of  the  first  kind.  (HP-UX  utility.) 

C  yn  Bessel  function  of  the  second  kind.  (HP-UX  utility.) 

$ALI 

$ALIAS  jn  =  'jn'  (llval,  ^val) 

AS  yn  =  'yn'  (lival,  lival) 

subroutine  plane_scat ter(acc ,  ka,  kr,  phi,  n,  accl,  dsp) 
i  iiiplicit  none 
integer*^  n 

real*8  acc,  ka ,  kr,  accl,  phi 
complex'*16  dsp 

integer *4  j,  1 
r  (j  a  1  *  8  a  c  c  2 

complex*16  aj ,  i,  i j ,  x 


o  o 


X 


c 

c 

c 

c 

c 


re  = 


*  d/dx(jn(kx)). 


ira  =  X  *  d/dx( yn (kx ) ) . 


re(n,  kr)  =  n  *  jn(a,  kr)  -  kr  *  jn((n+l),  kr) 
im(n,  kr)  =  n  *  yn(n,  kr)  -  kr  *  yn((n+i),  kr ) 


acc2  =  0. 

i  =  dcmplxCO. ,  1 .  ) 


if  (ka  .eq .  0.  )  Chen 
n  =  0 
accl  =  0. 
dsp  =  0. 
else 
C 

C  j=0  term  of  Che  summation. 

C 

j  =  0 

aj  =  -re(j,  ka)  /  dcmplx(re(j,  ka),  ira(j,  ka ) ) 
dsp  =  aj  *  dcmplx(jn(j,  kr),  yn(j,  kr)) 

C 

C  Calculate  the  j=l  through  j=n  terms 
C 

do  j  =  1 ,  50 

aj  =  re(j,  ka)  /  dcmplx(re(j,  ka),  im( j ,  ka)) 

C 

C  Calculate  i*j* 

C 

1  =  n!od(j  ,  4) 
if  (1  .eq.  0)  then 
ij  =  1. 

else  if  (1  .eq.  1)  then 
ij  =  i 

else  if  (1  .eq.  2)  then 
ij  =  -1. 

else  if  (1  .eq.  3)  then 
ij  =  -i 
end  if 

aj  =  -2.  *  ij  *  aj 
C 

^  Calculate  the  jth  terra  of  the  sura. 

X  =  (aj  *  dcraplx(jn(j,  kr),  yn(j  ,  kr)))  *  cos(j  *  phi) 

Determine  the  accuracy  level  for  the  sum  with  j  terms. 

accl  =  abs(x)  /  abs(dsp) 

Add  tile  jth  term  to  the  sum. 

dsp  =  dsp  +  X 
n  =  j 


n  o 


H.  2  Line  Source  Scattering 


The  prograta  listed  in  this  Section  models  the  scattering  of  SH-wave 
pulses  from  a  cylindrical  cavity.  The  SH  waves  incident  on  the  cavity  radiate 
from  a  line  source  in  a  space  that  is  represented  either  as  an  infinite  loss¬ 
less  space  or  as  a  lossy  two-layered  half-space  through  the  selection  of 
appropriate  options. 

A  sample  input  file  and  the  first  few  lines  of  an  output  file  for  the 
program  are  shown  in  Section  H.2.2. 

H.2.1  Synthetic  Seismogram  Program 

H. 2 . 1 . 1  synseis 


C 

C 

C 

C 

C 

C 


Procedure  name:  synseis 

Author:  J.C.  Biard 

Discussion:  This  is  the  main  procedure  for  Che  program  synseis. 

This  program  calculates  the  time  domain  SH-wave  seismic  propagation 
and  scattering  for  a  line  source  and  an  array  of  detectors  in  the 
presence  of  an  infinite  cylindrical  cavity  of  constant  circular 
cross-section  in  an  elastic  space.  The  program  is  designed  to  allow 
for  the  presence  of  a  half-space  of  vacuum  if  desired,  as  well  as  a 
surface  layer  located  between  the  elastic  half-space  and  the  vacuum. 
Attenuation  and  dispersion  are  also  included. 

The  intent  of  the  program  is  to  produce  data  for  a  synthetic 
seismogram.  As  presently  written,  a  set  of  tine  domain  signals  are 
produced,  one  for  each  of  a  linear  horizontal  array  of  detectors. 

These  signals  are  the  particle  velocity  amplitudes  at  each  detector  of 
a  horizontally  pola-ized  shear  (SH)  wave  that  has  propagated  through 
the  space  and  scattered  from  the  cavity  within  it.  If  selected,  the 
presence  of  the  half-space  surface  and  the  surface  layer  produce 
reflections  of  the  direct  propagating  and  scattered  signals,  which 
become  part  of  the  time  domain  signal.  The  inclusion  of  different 
velocities,  densities,  and  attenuat ion 'dispersion  values  in  the 
different  media  allow  for  modeling  a  number  of  different  earth 
geometries. 

The  output  data  arrays  containing  the  signal  amplitudes  at  each 
detector  are  written  out  to  a  file,  which  may  then  be  interpreted 
t>y  a  graphics  presentation  program  to  produce  a  synthetic  seismogram. 

The  input  data  for  the  program  are  contained  in  a  file,  the  name 
of  which  is  passed  to  the  program  on  invocation.  An  example  input  file 
is  shown  below. 

The  output  data  are  written  to  standard  out,  which  must  be 
redirected  to  a  file  if  the  data  are  to  be  saved. 

invocation:  To  run  the  program,  after  compilation  and  linking  with  the 

subroutines,  typo  "synseis  infile",  where  infile  is  the  input  filename. 
The  output  may  be  redirected  to  a  file  by  typing  the  command  as 
synseis  infile  >  outfile",  where  outfile  is  the  output  file  name. 
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o  r>  o 


The  input  file  has  the  form: 


3 

200.,  1500. 

50.,  .05 

2500.,  2700. 

100.,  .05 

1000.,  .9 
39.78873577d0 

1.,  5. 

0.,  -50. 

-52.,  -6. 
-50.,  -6. 

51,  2. 


$  N’o.  of  reflections.  (0=space,  l  =  l/2space,  >  =  2  =  1  ayered) 
$  Layer  1:  Sll-wave  veloc i ty (m/s ) ,  dens i ty (kg /n** 3  ) . 

$  Q  factor,  reference  radial  frequency. 

$  Layer  2:  SH-wave  ve loci ty (m/s ) ,  densi ty (kg/m**3 ) . 

$  Q  factor,  reference  radial  frequency. 

$  Pulse  peak  freq.,  distribution  factor. 

$  Frequency  step. 

$  Tunnel  radius,  layer  depth  (h  >=  0.). 

$  Tunnel  location  (x,  y). 

$  Source  location  (x,  y). 

$  Detector  array  starting  point  (x,  y).  (y  >  -h) 

$  No.  of  detectors,  spacing. 


Procedures  called  from  this  module; 

inc  pulse  Subroutine  that  calculates  the  incident  waveform 
for  a  source  and  detector  in  the  lower  region. 
inc_pulse2  Subroutine  that  calculates  the  incident  waveform 

for  a  source  in  the  lower  region  and  a  detector 
on  the  surface  of  the  half-space. 
scat_pulse  Subroutine  that  calculates  the  scattered  wa'/eform 
for  a  source  and  detector  in  the  lower  region. 
scat_pulse2  Subroutine  that  calculates  the  scattered  waveform 
for  a  source  in  the  lower  region  and  a  detector 
on  the  surface  of  the  half-space. 


C 

C 

C 

C 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 


Formal  Arguments: 

Input : 

input  Filename  of  the  input  data  file. 

Output : 
none 


External  variables: 

nrefl  Number  of  reflection  waves  to  calculate.  (0<  =  nref 1<=6 ) 

pi  Pi . 

h  Thickness  of  the  surface  layer,  (m) 

cl  S!i-wave  velocity  in  the  surface  layer,  (m  /  s) 

rhol  Density  of  the  surface  ’ayer.  (kg  /  m) 

c2  SH-wave  velocity  in  the  lower  region,  (m  /  s) 

rho2  Density  in  the  lower  region,  (kg  /  m) 

a  Radius  of  the  tunnel,  (m) 

alpha  Shape  factor  for  the  incident  pulse. 

wO  Peak  radial  frequency  for  the  incident  pulse. 

df  Frequency  step.  (Hz) 

xc  X  position  of  the  cavity  center. 

yc  Y  position  of  the  cavity  center. 

ql  Quality  factor  for  the  surface  layer. 

wl  Cutoff  radial  frequency  for  the  surface  layer. 

q2  Quality  factor  for  the  lower  region. 
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c 

c 


w2  Cutoff  radial  frequency  for  the  lower  region. 


program  synse is ( input ) 
implicit  none 
character  input*80 
integer*4  nrefl 

real*8  pi,  h,  cl,  rhol,  c2 ,  rho2,  a,  alpha,  wO,  df ,  xc ,  yc ,  ql, 
1  wl,  q2,  w2 

common  /constants/  nrefl,  pi,  h,  cl,  rhol,  c2,  rho2,  a, 

1  alpha,  wO,  df,  xc,  yc,  ql,  wl ,  q2,  w2 

integer*-^  i,  j,  fdi,  nx,  np,  timel,  tirae2 

real*S  ti,  ts,  dt,  scale,  x,  y,  xs ,  ys ,  dx,  xO,  yO,  alphaO,  fO 
real*6  ipulse(4096 ) ,  spulse(A096) 


save  ipulse,  spulse 
data  fdi,  np  /  10,  4096/ 


C 

C 

C 


c 

c 

c 


?i  =  3. 141 392653589793dO 
Obtain  the  run-time  constants. 


open(unit 
read (fdi, 
read( fdi , 
read( fdi  , 
read (fdi, 
read( fdi  , 
read (fdi, 
read (fdi, 
read (fdi, 
read(fdi  , 
read(fdi  , 
read(fdi  , 
read( fdi  , 
close (fdi  ) 
wO  =  2.  * 
alpha 
dt  = 


fdi,  file  == 
nrefl 
c 1 ,  rho 1 
ql ,  wl 
c:,  rho: 
q2,  w2 
fO,  alphaO 

df 

a ,  h 
xc  ,  yc 
xs  ,  ys 
xO ,  yO 
nx,  dx 

*  fO 


*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

pi 

=  alphaO  *  wO  /  pi 
1.  /  256.  /  df 


input , 


status 


11^ 


N 


Find  the  l-meter  incident  amplitude  scale  factor. 

call  inc  pulsc(0.d0,  — 500.d0,  l.dO,  — 500.d0,  l.dO,  ti,  ipulse) 
scale  =  0. 
do  i  =  1 ,  np 

scale  =  [na;<(scale,  abs  (  ipulse  (  I  ))  ) 
end  do 

Scale  =1.  /  scale 
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c 

Write  out  tlie  constants. 

write(6,*)  nx ,  np,  nrefl,  h,  cl,  rhol,  c2 ,  rho2,  wO,  alphaO,  df, 
1  dt,  a,  xc,  yc,  xs,  ys,  xO,  yO,  ql,  wl,  q2,  w2,  dx 

C 

C  Loop  over  the  nuraber  of  detector  positions 
C 

y  =  yO 

do  i  =  1 ,  nx 

X  =  xO  +  (i-l)*dx 
C 

C  Calculate  the  incident  pulse. 

C 

call  tiineCtimel) 
if  (yO  .ne.  0)  then 

call  inc_pulse(xs ,  ys ,  x,  y,  scale,  ti,  ipulse) 
else 

call  inc_pulse2(xs ,  ys ,  x,  scale,  ti,  ipulse) 
end  if 

call  t i me ( t i ne  2  ) 
timel  =  time 2  -  tinel 
write(7,  *)  timel 
C 

C  Calculate  the  scattered  pulse. 

C 

call  tine(tirael) 
if  (yO  .ne.  0)  then 

call  scat_pulse(xs,  ys,  x,  y,  scale,  ts,  spulse) 
else 

call  scat_pulse2(xs ,  ys ,  x,  scale,  ts,  spulse) 
end  if 

call  time (time 2) 
timel  =  time!  -  timel 
write (7,  >')  limel 
C 

C  Write  out  the  'ncident  and  scattered  pulses  to  the  output  files. 

C 

write(6,  *)  x,  ti,  ts 
write(6,  *)  (ipnlse(j),  j  =  1,  np) 
write(6,  *)  (spulse(j),  j  =  1,  np) 
end  do 
stop 

end 


H.  7  .  1 . 2  i  nc_jiu  1  s^ 

C 

C  Procedure  name:  inc_pulse 
C 

C  Autiior  :  J.C.  Biard 

C 
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C 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 


Discussion  :  This  procedure  produc.  s  a  numerical  solution  of 

the  equation  for  a  line-source  Sh  seismic  wave  propagating  in 
a  dispe  ’ve  absorptive  half-space  having  a  surface  layer  as  give.-i 
by  Equation  (151)  of  Volume  I.  The  source  and  detection  points  are 
located  in  the  region  below  the  surface  layer.  At  the  detection 
point,  the  time  domain  signal  for  the  direct  wave  and  up  to  nrefl 
reflections  from  the  layer  interface  and  Che  half-space  surfac'^  are 
calculated  using  a  high-frequency  limit  approximation  formula.  This 
result  is  reported  in  the  array  output. 

To  calculate  a  signal  in  Che  time  domain,  the  frequency  domain 
transfer  function  is  calculated  and  converted  into  the  time  domain 
impulse  response  for  the  propagation  path.  This  is  then  convolved 
with  the  initial  signal  to  produce  the  signal  at  Che  detector. 

This  process  is  repeated  for  the  direct  wave  and  all  allowed 
reflections.  These  time  domain  signals  are  then  summed  together 
to  present  the  final  signal. 

The  transfer  function  that  is  calculated  is  multiplied  by 
j  *  omega  before  Che  Fourier  transform  in  order  to  obtain  the 
time  derivative  of  Che  displacement  amplitud-'  signal  upon 
convolving  with  the  initial  signal.  The  .ting  particle 

velocity  signal  is  the  signal  most  oft  .  esented  in  seismic 
stud ies . 

Procedures  called  from  this  module: 

ffc2c  IMSL  subroutine  to  calculate  the  Fourier  transform, 

jhc  subroutine  Co  calculate  Bessel  and  Hankel  functions, 

pulse  function  Co  calculate  the  original  signal, 

zk.  function  to  calculate  the  complex  wavenumber. 

Formal  arguments: 

Input : 
xs 
ys 

X 
>■ 

scale 
Output : 

t  Time  value  of  the  initial  element  of  the  output  array, 

output  Array  of  Che  particle  velocity  signal  waveform  values. 

External  variables: 

nrefl  Number  of  reflection  waves  to  calculate.  (0<=nre f 1<=6 ) 

pi  Pi . 

h  Thickness  of  the  surface  layer,  (m) 

cl  SH-wavc  velocity  in  the  surface  layer,  (m  /  s) 

rhol  Density  of  the  surface  layer,  (kg  /  m) 

c2  SH-wjve  velocity  in  the  lower  region,  (m  /  s) 

rho2  Density  in  the  lower  region,  (kg  /  m) 

a  Radius  of  Che  cavity,  (m) 

alpha  Shape  factor  for  the  incident  pulse. 


X  position  of  the  line  source. 

Y  position  of  the  line  source. 

X  position  of  the  detector. 

Y  position  of  the  detector. 

Scale  factor  to  apply  to  the  output  waveform. 


o  o  o 


C  wO  Peak,  radial  frequency  fur  the  incident  pul-^e. 

C  df  Frequency  step,  (Hz ) 

C  xc  X  position  of  the  cavity  center. 

C  yc  Y  position  of  the  cavity  center. 

C  ql  Quality  factor  for  the  surface  layer. 

C  wl  Cutoff  radial  frequency  for  the  surface  layer. 

q2  Quality  factor  for  the  lower  region. 

w2  Cutoff  radial  frequency  for  the  lower  region, 

subroutine  inc_pulse(xs,  ys,  x,  y,  scale,  t,  output) 
implicit  none 

real*8  xs ,  ys,  x,  y,  scale,  t,  output(4C96) 
integer*4  nrefl 

real*8  pi,  h,  cl,  rhol,  c2,  rho2 ,  a,  alpha,  vO,  df,  xc ,  yc,  ql, 
1  w 1 ,  q2 ,  w2 

common  /constants/  nrefl,  pi,  h,  cl,  rhol,  c2,  rho2,  a,  alpha, 

1  wO,  df ,  xc ,  yc ,  ql,  wl,  q2,  w2 

integer*^  i,  j,  1,  m,  n,  work(9),  ier 
real*8  dk ,  k,  r,  dt,  ti,  sum,  v,  w,  tsi2,  u,  tdy 
real*8  pwave(256),  twave(256) 

complex*16  k2,  kr,  z,  jn(2),  hn(2),  ftrans(256) 
conplex*16  ij ,  krp,  nu,  rp,  s,  bn 

real'8  pulse 

complex*16  zk,  znu 

znu(k)  =  zk(l,  k  *  c2  /  cl)  /  zk(2,  k) 

C 

C  Initialize  constants. 

C 

data  m  /  8/ 

ij  =  dciiiplx(0.d0,  l.dO) 
dt  =  1.  /  (256.  *  df) 
dk  =  2.  *  pi  *  df  /  c2 
u  =  h  /  (abs(yc)  -  h) 

tsi2  =  (rhol  *  cl**2)  /  (rho2  *  c2**2) 

C 

C  Calculate  the  path  length  time  offset. 

C 

r  =  sqrt((xs  -  x)**2  >■  (ys  -  y)**2) 
k  =  128.  *  dk 
kr  =  zk(2 ,k)  *  r 

t  =  dble(kr)  /  k  /  c2  -  20. dO  *  dt 
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Clear  the  output  array. 

do  i  =  1 ,  4096 

output(i)  =  O.dO 
end  do 

Calculate  the  array  for  the  pulse  waveform. 

do  i  =  1,  256 

ti  =  (i-1)  *  dt 
pwave(i)  =  pulse(ti) 
end  do 

Calculate  the  transfer  function  for  the  signal. 

Loop  over  the  direct  wave  (nrefl  -  0)  and  all  reflections. 

do  i  =  0,  nrefl 
n  =  i  -  1 

Calculate  the  time  delay  for  the  signal. 

if  (i  .gt.  0)  then 
k  =  127.  *  dk 
nu  =  znu(k) 
rp  =  sqrt((x  -  xs)**2 

1  +  (y  +  ys  +  2.d0*(l.d0  -  dble( n ) *nu )*h ) **2 ) 

tdy  =  dble(rp  *  zk(2,  k))  /  k  /  c2  -  20. dO  *  dt 
e  Ise 

tdy  =  t 
end  if 

Calculate  the  value  of  the  transfer  function  for  the  signal  at 
wavenumbers  from  0.  to  12.7.  The  k  =  0.  value  is  sot  to  0. 

f  trans( 1 )  =  O.dO 
do  j  =  2,  128 

k  =  (j  -  1)  *  dk 

Get  the  complex  wavenualjr. 

This  allows  for  attenuation  and  dispersion. 

k2  =  zk(2,  k) 
if  (i  .eq.  0)  then 

Find  the  direct  terra. 


kr  =  k2  *  r 

call  jhc(kr,  2,  jn,  hn) 
z  =  hn(  I ) 
else 


o  r. 


c 

C  Kind  a  re  f  1  e  c  t  i  i:.n  t.-rn. 

C 

nu  =  znu(k) 

rp  =  zsqrt((x  -  xs)**2 

1  +  (y  +  ys  +  2,d0*(l.'>0  -  dble  ( n)  *nu  )  *h)  *  *2  ) 

C 

Calculate  tlie  reflection  coefficient. 

s  =  (tsi2  *  nu  -  l.dO)  /  (tsi2  *  nu  +  l.dO) 
if  (n  .eq.  0)  then 
bn  =  -s 
else 

bn  =  (l.dO  -  s**2)  *  s**(n-l) 

1  *  2sqrt((l.d0  +  u  *  dble(n)  *  nu ) 

2  /(l.dO+u*dblc(n)/nu)) 
end  if 

V  r  p  =  k.  2  *  r  p 
call  jhc(krp,  2,  jn,  hn) 
z  =  bn  hn  (  t  ) 
end  if 

z  =  ij  *  pi  *  z  *  (dble(k2)  /  k  /  c2)**2 
C 

C  The  procedure  presently  calculates  the  particle  velocity  signal. 

C  To  calculate  displacenent  ainpl  i  tud«:-s ,  conruiit  the  next  line. 

C 

z  =  -ij  *  k  *  c2  *  z 
C 

C  Renovo  the  t  i  r?,e  delay  from  th.e  transfer  function. 

C 

V  =  k  *  c2  *  tdy 

ftrans(j)  =  ze\p(-ij  *  v)  *  z 
e n d  do 
C 

C  Force  the  high  k  value’s  to  zero. 

C 

j  =5.  /  dk 
w  =  128.  *  dk  -  5. 
do  1  =  j ,  128 

V  =  1  *  dk  -  3. 

ftrans(l)  =  ftrans(i)  *  (1.  +  cos(v  *  pi  /  w))  /  2. 
end  do 
C 

C  Perforin  the  Inverse  Fourier  transform. 

C  Cenerate  the  full  complex  siiectrum  and  C”njugite  it  to  prepare 

C  for  the  back  transform. 

C 

C  Reflect  the  spectrum  for  negative  f roipienc  ies . 

C 

do  1  =  2,  128 

f  t  rans  (  2  38-1  )  ==  con  jg(  f  t  rans  (  1  )  ) 
c-nd  do 

ftrans(129)  =  0. 
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c 

c 

c 


Conjuf.  ite  till-  full 


C 

C 

C 

C 

c 

c 


c 

c 

c 


c 

c 

c 

c 


do  1  =  1,  256 

ftruusd)  =  conj  f  t  runs  (  ’  )  ) 
e  n  d  d  o 

Fourier  trap.' fern. 

call  f  f  t  2c  (  f  L  raua  ,  ,  work) 

Conjiurice  and  nor:nalize. 
do  1  =  1,  25b 

ftrans(l)  =  coa j  n. (  f  t:  rai'.-;  (  I  )  )  *  dt 
end  do 

Co",v  live  the  pulse'  and  the  trar.s'er  funatlon,  an.i  norT.n.  i  iz-' . 

do  1  =  1,  256 
sun  •-  0. 
do  j  =  1,  1 

sun  =  sun  pwaved  -  j  +  I)  *  dble- ( f  t  tatis  (  j  ) ) 
end  do 

twavo(l)  =  scale  *  sum  *  dr  /  (4.  *  pi  *  rho2) 
end  do 

Find  the  offset  of  the  tine  doniin  sijnil  in  the  oiitinit  ai  ra/ 
and  sun  the  s'’znal  into  the  tot  U  result. 

j  =  (tdy  -  t)  /  dt 
do  1  =  I,  256 

output (1  +  j)  =  output (1  +  j)  +  twive(L) 
end  do 
enr!  do 
return 


end 


H. 

C 

C 

C 

c 

c 

c 

c 

c 

c 

c 

c 


2.1.3 


inc-p u 1 s  e  2 


Procedure  nan-' :  Inc  pul  so  2 

;  J.C.  BiarJ 

discussion  :  This  pro.’odure  produces  a  nnn.'rical  solution  of 

the  equation  for  a  line-source  SM  seisnic  wave  prop  ij;a  t  i  np,  in 
a  dispersive  absorptive  half-space  havinji  a  surface  layer  as  given  by 
F.quition  (167)  in  Volune  I.  The  source  is  located  in  the  region  h-'liiw 
the  surfrice  layer.  The  detector  point  is  located  at  the  half-spice 
boundary,  which  i'l  the  top  of  the  surfac.'  layer.  At  the  detection 
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point,  the  tine  donnin  si^^nal  ‘’or  tliC  direct  wave  c^nd  up  to  nrefl 
reflections  flora  the  layer  interface  and  tlie  half-space  surface  are 
calculated  using  a  high-frequency  limit  approximation  formula. 

This  result  is  reported  in  the  array  output. 

To  calculate  a  signal  in  the  time  domain,  the  frequency  domain 
transfer  function  is  calculated  and  converted  into  the  tine  domain 
impulse  response  for  the  propagation  path.  This  is  then  convolved 
with  ttie  initial  signal  to  produce  the  signal  at  the  detector. 

This  process  Is  repeated  for  the  direct  wave  and  all  allowed 
reflections.  These  time  domain  signals  are  then  summed  together 
to  present  the  final  signal. 

The  transfer  function  that  is  calculated  is  multiplied  by 
j  *  omega  before  the  Fourier  transform  in  order  to  obtain  the 
time  derivative  of  the  displacement  amplitude  signal  upon 
convolving  with  the  initial  signal.  The  resulting  particle 
velocity  signal  is  the  signal  most  often  presented  in  seisraic 
studies. 

Procedures  called  from  this  module; 

fft2c  IMSL  subroutine  to  calculate  the  Fourier  transform, 
jhc  subroutine  to  calculate  Bessel  and  Hankel  functions, 

pulse  function  to  calculate  the  original  signal, 

zk  function  to  calculate  the  complex  wavenumber. 

Formal  arguments: 


Input : 


y 

scale 


X  position  of  the  line  source. 

Y  position  of  the  line  source. 

X  position  of  the  detector. 

Y  posiii  of  t  he  detector. 

Scale  factor  to  apply  to  the  output  waveform. 


Output : 

t 

output 


Time  value  of  the  initial  element  of  the  output  array. 
Array  of  the  particle  velocity  signal  waveform  values. 


Fxternal  variables: 

nrefl  Number  of  reflection  waves  to  calculate.  (0<=nref 1<=6 ) 

pi  Pi . 

h  Thickness  of  the  surface  layer,  (m) 

cl  SH -wave  velocity  in  the  surface  layer,  (m  /  s) 

rhol  Density  of  the  surface  layer,  (kg  /  m) 

c2  SH-wave  velocity  in  the  lower  region,  (m  /  s) 

rho2  Density  in  the  Ijwer  region,  (kg  /  m) 

a  Radius  of  the  cavity,  (m) 

alplia  Shape  factor  for  the  incident  pulse. 

wO  Peak  radial  frequency  for  the  incident  pulse. 

df  Frc  piency  step.  (Hz) 

xc  X  position  of  the  cavity  center. 

yc  Y  position  of  the  cavity  r.nter. 

ql  Quality  factor  for  the  surface  layer. 


'V15R61: 


c 

c 

c 

c 


wl  Cutoff  radiol  frequency  for  the  surface  layer. 

q2  Quality  factor  for  the  lower  region. 

w2  Cutoff  radial  frequency  for  the  iow.jr  region. 

subroutine  iac_pul so 2 ( xs ,  ys ,  x,  scale,  t,  output) 


implicit  none 


real*o 

xs,  ys,  X, 

scale,  t , 

output ( 4096 ) 

integer*4 

nrefl 

real*8 

pi,  h,  cl. 

rho 1 ,  c2  , 

rho 2,  a,  alpha,  wO ,  df,  xc ,  yc ,  ql. 

1 

wl ,  q2 ,  w2 

common  /constants/  nrefl,  pi,  h,  cl,  rhol,  c2,  rhi.)2,  a,  alpha, 
1  wO,  df,  sc,  yc,  ql,  wl,  q2,  w2 


integor*A 

real*8 

real*8 

real*8 

complex*  1 6 

cornplex*l6 


i,  j,  1,  m,  n,  work(9),  "er 

dk,  k,  r,  dt,  ti,  sum,  v,  w,  tsi2 

u ,  tdy 

pwave(256),  cwave(256) 

k2,  kr,  z,  jn(2),  hn(2),  ftrans(2'h) 

ij ,  krp,  nu,  bn,  s,  rp,  p 


real*8  pulse 
coraplex*16  zk ,  znu 


znu(k)  =  zk(l,  k  *  c2  /  cl)  /  zk(2,  k) 
C 

C  Initialize  local  constants. 

C 

data  ra  /  8/ 


ij  =  dcmplx(0.d0,  l.dO) 

dt  =  1.  /  (256.  *  df) 

dk  =  2.  *  pi  *  df  /  c2 

u  =  h  /  (2.d0  *  abs(yc)  -  h) 

tsi2  =  (cl**:  *  fhol)  /  (c2**2  *  rho2) 

C 

^  Zero  the  output  array. 

do  i  -  1,  4096 

output(i)  -  O.dO 
end  do 

^  C 

f  c 

^  Calculate  the  array  for  the  pulse  waveform. 

do  1  =  1,  256 

ti  =  (i-1)  *  dt 
pwave(i)  =  pulse(ti) 
end  do 


1 


non  non 


C 

C  Loop  ever  the  direct  wove  (0)  and  all  ref  lei  t  io--- . 

C 

do  i  =  0,  iirefl 
C 

C  Calculate  the  path  length  tin;e  offset. 

C 

k  =  127.  *  dk 
nu  =  znu(k) 

rp  =  zsqrt((x  -  xs)**2 

1  +  (ys  +  h  -  (l.dO  +  2.d0  *  dble( i ) )*nu*h)**2 ) 

tdy  =  dble(rp  *  zk(2,  k))  /  k  /  c2  -  20. dO  *  dt 
if  (i  eq.  0)  then 
t  =  tdy 
end  i  f 
C 

Lo  ,<p  over  the  wavi.-riunbe rs  from  dk  to  127  *  dk  to  get  the  trausfer  f  otetion 
values.  Set  the  k  =  0  ti-rra  to  zero. 

ftrans(l)  =  O.dO 
do  j  =  2,  128 

k  =  (j  -  1)  *  dk 
nu  =  znu(k) 

Got  th,e  coitplex  wavenu;r.ber . 

k2  =  zk(2,  k) 
krp  =  k2  *  rp 
C 

C  Kind  the  direct  and  reflection  terms. 

C 

rp  =  ziqrt((x  -  xs)**2 

1  +  (ys  +  h  -  (l.dO  +  2.d0  *  dbl e ( i ) ) *nu*h ) **2 ) 

C 

C  Find  the  reflection  coefficient. 

C 

p  =  li.dO  /  (tsi2  *  nu  +  l.dO) 
s  =  (tsi2  *  nu  -  l.dO)  /  (tsi2  *  nu  +  l.dO) 
bn  =  p  *  s**i 

1  *  zsqrt((l.d0  +  u  *  (l.dO  +  2.d0  *  dble(i))  *  nu) 

2  /  (l.dO  +  u  *  (l.dO  +  2.d0  *  dble(i))  /  nu)) 
call  jhc(krp,  2,  jn,  hn) 

z  =  bn  *  hn( 1 ) 

z  =  -ij  *  pi  *  z  *  (dble(k2)  /  k  /  c2)**2 
C 

C  The  next  statement  generates  the  particle-velocity  sign.il  transfer 
C  function.  To  obtain  displacement  amplitude  results,  i-omment  the 

C  next  line. 

C 

z  z  *  ij  *  k  *  c2 
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c 

C  SubLi'act  iho  tirie  delay. 

C 

v=k*c2  *tdy 
fCran<(J)  =  ze>;;>(-ij  *  v)  *  z 
e  nd  do 
C 

Fo'ce  die  hijh  k  values  to  zero. 

j  =  5.  /  dk 
w  =  12'^.  *  dk  -  5. 
do  1  =  j ,  128 

V  =  1  *  dk  -  5 . 

ftrans(l)  =  ftraiisCl)  *  (1.  +  cos(v  *  pi  /  w))  /  2. 
end  do 

Generate  the  full  complex  spectrum  and  conjugate  it  to  prepare  for  the 
back  transform. 

Reflect  the  spectrum  for  negative  frequencies, 
do  1  =  2,  128 

traas(258-l)  -  coajg( f t r ans ( 1 ) ) 
end  do 

f  t  rans (129)  =  0. 

Conjugate  the  full  spectrum, 
do  1  =  1 ,  256 

ftransCl)  =  conj g( f t rans ( I )  ) 
end  do 

Inverse  Fourier  transform. 

call  f f t 2c ( f t rans  ,  m,  work) 

Conjugate  and  normalize, 
do  1  =  1 ,  256 

ftrans(l)  =  conjg( f t rans( I  )  )  *  df 
end  do 

Convolve  the  pulse  and  the  transfer  function,  and  normalize. 

do  1  =  1,  256 
sum  =  0. 
do  j  =  1,  I 

sum  =  sum  +  pwaveCl  -  j  +  1)  *  dble ( f t rans ( j ) ) 
end  do 

twave(l)  =  scale  *  sun  *  dt  /  (9.  *  pi  *  rho2) 
end  do 
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c 

C  Find  ihe  offset  into  t  lie  output  -.rray,  and  .uid  the  emit  ri  biit  i.jii  f 
C  the  present  vavc  to  the  total  result. 

C 

j  =  (tdy  -  t)  /  dt 
do  1  =  1,  256 

outputCl  +  j)  =  outpurd  +  j)  +  twave(l) 
end  do 
end  do 
return 

end 


H.  2  .  1 .  A  jhc^ 


C 


c 

r 

Procedure  Name: 

j  he 

L* 

c 

r 

Author : 

J.C. 

liiard 

c 

Discussion: 

This 

procedure  calculates  the  complex  Bessel  and 

Hankel  functions  for  conplex  argument  z  for  orders  zero  through 
ra-1  and  places  the  results  in  the  arrays  jn  and  hn. 


The  results  are  obtained  using  series  approximations  to  the 
0th  and  tst  order  Bessel  and  N’eunann  functions  for  complex  arg  .'-ent 
as  given  in  Gradshteyn  and  Ryzhik.  (1965)  and  uses  the  recursion 
formula  for  Bessel-class  functions  to  obtain  the  values  at  t’ne  ’lig'.er 
orders.  There  are  two  different  series  approxi  raa  t  i  ons  used  tor  t!ie 
calculations,  one  for  small  values  of  the  argument  and  one  for  large 
values  of  the  argum>-nt.  The  number  of  terms  calculated  and  t^e 
coefficients  used  were  cliusen  so  that  there  is  a  region  of  .■>v.,-rlap 
between  the  two  solutions,  thus  providing  an  accurate  and  smooth 
transition  between  the  two  regions. 

The  constants  in  the  a  array  were  precalculated  to 
speed  the  algorithm. 

Procedures  called  from  this  module; 

none 

Formal  arguments: 

Input  : 

z  The  complex  valued  argument  for  the  functions, 

ra  The  numb<‘r  of  orders  to  find  (from  0  to  m-1). 

C 

C  Output: 

C 

C  jn  An  ay  of  the  Bessel  functions  of  ordi^r  0  to  m-1  of  z. 

C  Must  be  at  least  2  elements. 
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C  hp, 

C 

c 

C  KxtcrM  il  v.,1 iab  I 
C 

C  nopp 

C 

subr.j'it  ■  ;ie  jhc(z,  m,  jn,  hn) 
inp  1  i  c  i  t.  m.'-  ■: 
intpgor'*-'*  □ 

comp  lex*  16  z,  jn(ai),  hn(ni) 
integor*4  i,  j 

real*3  pi,  c,  a(lOO),  al(51),  a2(49) 

conp lex* 1 6  u,  v,  z2,  z22,  lnz2c,  ji,  jil,  ji2,  nl,  nil,  nil 
con'.plex*16  jli,  j2a,  w,  wp ,  wm,  wf ,  ul,  vl,  an,  ab,  itn 

equivalence  (a(l),  al(l)),  (a(52),  a2(l)) 

C 

C  Initialize  local  constants. 

C 

data  pi,  c/  3.14159265358979330,  .57/21566490153330,' 
data  a  1  / 

*  2. OOOOOOOilOOOOOOOdO,  3. 00000000000000030,  3. 6666666656666  6  7  30 , 

*  4.  16666666666666630,  4.  566666:>66666666'530,  4.8999999999999993  ), 

*  5.  1  857  142857  1  423530,  5.4  3  57  142837  1  428  330.  5. 657  9 3b50 79 36 50 730 , 

*  5.857936307936503  ),  6.03975468973468930,  6.20642135642135630, 

*  6. 36026751026751030,  6.  303!  246531 2465430,  6. 68o4  57  98 >4 5  7'-i 730 , 

*  6.  76145798045798730,  6. 8 79 1 0504328 1 5 1 630 ,  6. 9902  1 n 1  56 3 92p 2 7d0  , 

*  7.095a793  1  42873643O,  7.  195 '■  79314287364JO,  7 , 2907  1  7409  52  54  5  >30  , 

*  7. 381n2650043453030,  7.4685830221  736^030,  7 . 55 1 9 1 n  35550 '0 1  idO , 

*  7.63191635550701430,  7.  7088394324  j009i).j0,  7.  7829  1  3  50630  *  1  6 530  , 

*  7. 85a3420779 5273630,  7.92430759517411530,  7 . 98997 426 1 34078 IdO , 

*  8.05449039037  304030,  8.  I  1  69903908/  30-4030  ,  8.  1  7759645147910130, 

*  3.236419980891)86530,  8 . 293 3625 380 3 3 7 22dO ,  8.  349 1 1 8 39  -  i892 7 730 , 

*  8.4031  7244764333230,  8 . 45580402659070030 ,  8. 50708607 78 72 7 5 1 30 , 

*  8.55708607787275230,  8.605866565677t.3OdO,  8.65343361329667730, 

*  8.69999724120365430,  8.  745451  78665819930,  8.  7898962 3 1  1 02o4  3d0 , 

*  8.83337449197220830,  8.87592763346156930,  8.91 75943501 2823330, 

*  8.95841067665884730,  8.99841067665834630,  9.03762636293335630,-' 

data  a 2,7 

*  9. 07P087901 39489430,  9.11382375043149330,  9.15086073743353530, 

*  9.  187224-42  3852  1  7230,  9.22293870956645830,  9. 2  580264  28-864  7U  330  , 

*  9.292  5091  8748 539330,  9.  3264074925701  3930,  9.  35974082 590 347230  , 

*  9.392  52  77  1  1  1  49  37330  ,  9. 424 7857 7 5o6550  330 ,  9. 4  5653 1 80 7 4 1  I  5 3 530 , 

*  9.48778180741153530,  9. 51855103818n7o630,  9.34835406343379730, 

*  9.  5/.8/0)8147524543n,  9.6081165794  58  3  3630,  9.63710208670-471  380, 

*  9.66567  151  52  /nl4230,  9 . 69  5842  529  36-On5030  ,  9.  7 I  620  307  1  3842880, 


Art'iy  ol  the  H.ink-jl  f  u-nc  t  iop-s  of  or-iji  0  to  nl  z. 
Mu  it  be  at  least  2  el-'r;'-,a  t  s  . 


I  MiiliWiM'iillilWiiiiK'iti-ir  r  Mtiliilii  iliilflMili 


F 


■r 


i 


i 


4 


t 

i 

I 


*  9 . 7  9 0  1  7  5 6  7  4  1  2 4 0 0 d 0 ,  9 .  7  7 *j 0 4 4  5 9 4 4  3 9 4  2  6d 0  ,  9 .  >  ■  1 2  7 1  1  2 b  11  r  f ■  i ;  9  .  j 0  , 

*  9.829027050579779d0,  9. 85500 1  u7b54  3K0  5dn  ,  9 .  bK064  2  1  02  1  94  - 'j^'idO  , 

*  9.905958557391033d0,  9.93095d557S91033d0,  9 , 9 5 564 99 1 59 1 5 7 2 5d0 , 

*  9.98U0401 59S18163dO, 10.004136545360332d0, 10.0279460691b9854d0, 

*  10. 051 4 754S093456Id0, 10. 074 7 31 29488805080, 10.0977198006351 76dO, 

*  10. 12044 707 3362449d0, 10. 1429189834 74 809d0, 10. 1 65 1 4 1 2056970 3 1 dO , 

*  10. 187119227675053d0, 10.208858358109836d0, 10.230363734453922d0, 

*  10.25164033019860380, 10.27269296177754980, 10. 29352629511088380, 

*  10. 31 41 44851 81 191 480,10.33455301 507 722 180,10. 354 7 5503 52 7924280, 

*  10.37475503527924180/ 

im  =  dcnplxCO.dO,  l.dO) 

C 

C  If  abs(z)  is  Itss  than  15  then  use  the  small  argument  .ipprciv  i  ma  ?  i  on . 
C  First  calculate  the  Bessel  and  Neumann  function  values  for  z. 

C 

if  (abs(z)  .It.  ’5.)  then 
z2  -  z  /  2.80 

lnz2c  =  2.80  (z1og(z2)  +  c) 

z22  =  z2*z2 
j i 2  =  0. 80 
j i 1  =  0. dO 
ni 2  =  0. dO 
nil  =  0. dO 
C 

C  Slum  th.e  terms  for  the  series,  starting  with  the  highest  index. 

C 

do  i  =  30,  I,  -1 

u  =  -z22  /  dble(i)  /  dble(i) 

V  =  -222  /  dble(i)  /  dble(i+l) 
a a  =  lnz2c  -  a(i) 

ab  =  lnz2c  -  a(i)  -  l.dO  /  dble(i+l) 
ji2  =  u  *  (l.dO  +  ji2) 
jil  =  V  *  (l.dO  +  jil) 
ni2  =u  *  (aa  +ni2) 
nil  =  V  *  (ab  +  ni!) 
end  do 
C 

C  Add  the  zeroth  terms  to  the 
C 

ji2  =  ji2  +  1.80 

jil  =  z2  *  (l.dO  +  jil) 

ni2  =  (lnz2c  +  ni2)  /  pi 

nil  =  (z2  *  (lnz2c  -  l.dO  +  nil)  -  l.dO  /  22)  /  pi 
C 

C  Generate  the  Jiankel  function  values  from  the  Bt'ssol  and  Neumann. 

C 

ni2  =  ji2  +  im  *  ni2 
nil  =  jil  +  im  *  nil 
else 
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If  3bs(/,)  is  greait'r  Chia  13  tht-i;  use  the  large  argurie:;-.  approx. 

z2  -  8.d0  *  z 
z22  =  z2^’'*: 
u  =  1. 
ul  =  1. 

V  =  1 . 

vl  =  1. 
ji2  =  1. 
j  2a  =  1 . 
j  i  1  =  1 . 
j la  =  3. 

Sun  the  terras  of  the  series, 
do  i  =  1 ,  10 

w  =  (4.d0  *  dble(i)  -  l.dO) 
w  p  =  w  +  2  .  d  0 
wn  =  w  -  2 .  d  0 
wf  =  2.d0  *  dble(i) 

u  =  -(w  *  um)**2  /  (wf  *  (wf  -  l.dO)  *  222)  *  u 
V  =  wp  *  u  /  w 
wa  =  w 
w  =  wp 

wp  =  w  +■  2.d0 

ul  =  -(w  *  wn)**:  /  (wf  *  (wf  +  l.dO)  *  z22)  *  ul 
vl  =  wp  *  ul  /  w 
ji2  -  u  +  ji2 
j2a  “  ul  +  j2a 

j  i  I  =  -V  +  j  i  I 

J  1  a  =  V 1  +  j  1  a 
end  do 

Apply  the  ext'Miiil  niiltiplying  faetors,  and  generate  tire  Bessel  and 
Hankol  function  values. 

u=z-pi  /  4.d0 

V  =  zsq  r  r ( 2 . dO  /  pi  /  z ) 


ni  2 

=  V 

* 

(ji2  -  in  *  j2a 

/  z2)  *  zexp(in 

*  u) 

ji2 

=  V 

A 

( j  i  2  *  z  c  0  s  ( u  )  + 

j  2a*zs i n (u ) /z2  ) 

ni  1 

=  V 

* 

(jla  /  z2  -  in 

*  ji 1 )  *  zexp(  ira 

*  u) 

jll 
end  if 

=  V 

A 

( j i 1 *zs i n(u  )  + 

j  I  a*/.cos  (u  )  /z2  ) 

Store  the  0th  and  1st  order  Bessel  and  Hankel  function  values, 


jn(l)  =  ji2 
jn(2)  =  ji 1 
( I  )  :=  ni  2 
(  2  )  =  nil 


M  1  1 


itftfttr^iifriri  iTi  - . . ■,.... 


r 
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C  Apply  tb.e  rec>irsii->n  rol.i^ion  to  obtain  the  hi^lu-r  i  ider  fjnition 
C 

do  i  =  3,  ra 

ji  =  2.<i0  *  dble(i  -  2)  /  z  *  jil  -  ji2 
ji2  =  jil 

jii  =  ji 

jn(i)  =  ji 

ni  =  2.d0  *  dble(i  -  2)  /  2  *  nil  -  ni2 
n i 2  =  nil 
nil  =  ni 
hi-  ( i )  =  ni 
end  do 
return 

end 


H ,  2 .  1 .  5  Fu n_c t  i oji  pulse 
C 

C  Procedure  name:  pulse 

C 

C  Author:  J.C.  Biard 

C 

C  Discussion:  This  procedure  calculates  the  value  of  a  time-dv'na i n 

C  wave  packet  function  at  the  time,  t,  using  F‘p.i.ation  (63)  in  Vislu-'..--  I. 

C  The  shape  and  central  frequency  of  the  pulse  is  determined  by  the 

C  external  variables  alpha  and  wO.  The  variable  alpha  controls  the 

C  wiilth  of  the  pulse  envelope  and  the  variable  wO  s,.*ts  ch;  rentral 

C  f.'tguency.  Alpha  is  cinsidered  as  a  fraction  of  wO  divided  by  pi.. 

C 

C  Procedures  called  from  itiis  mod.ule: 


f 


lone 

C 

C  Formal  arg,ir.>-ri  t  s  : 

C 

C  Input  : 

C 

C  t  The  time  in  seconds  for  whicli  (he  function  value  is 

C  di'sired. 

C 

C  Ou  L  pu  t  ; 

C 

C  pu’se  The  value  of  the  pulse  function  it  time  r. 

C 

C  F.vternal  va  r  i  .ibl  es  : 


'iref  1 

Number 

of 

ref  1 er 

tion  waves 

to  < 

■  il  cul ate 

.  (  0<  =  ii  r  e  f  1  <  - p  ) 

pi 

Pi  . 

h 

Thi ckuess 

of 

t  he 

surface  1 

lyor. 

(m) 

cl 

Si  1-wave 

vel  or 

1  ty 

in  the  surface 

1  aye  r . 

(m  /  s ) 
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r>  n  r>  ry  ry 


Density  of  ':he  sarfacr-  lay  ;  .  (kjj  /  m) 

SH-wav-j  veiioity  in  the  low-jr  region,  (m  /  s) 
Density  in  the  lower  region,  (kg  /  m) 

Radius  of  the  cavity,  (m) 

Shape  factor  for  the  incident  pulse. 

Peak  radial  frequency  for  the  incident  pulse. 
Frequency  step.  (Hz) 

X  position  of  the  cavity  center. 

Y  position  of  the  cavity  center. 

Quality  factor  for  the  surface  layer. 

Cutoff  radial  frequency  for  the  surface  layer. 
Quality  factor  for  the  lower  region. 

Cutoff  radial  frequency  for  the  lower  region. 


real*8  function  palse(t) 
iaplicit  none 
real*8  t 
integer*4  nrefl 

real *8  pi,  h,  cl,  rhol,  c2,  rho2,  a,  alpha,  wO ,  df,  xc ,  yc ,  ql, 
1  wl ,  q2 ,  w2 

connon  /constants/  nrefl,  pi,  h,  cl,  rhol,  c2,  rho2,  a,  alpha, 

1  wO,  df,  xc,  yc,  ql,  wl,  q2,  w2 

real*8  at,  wOt 


^  Calculate  the  function  value. 

C 

at  =  alpha  *  t 
wOt  =  wO  *  t 

pulse  =  at  *  exp(-at)  *  sin(wOt) 
return 


H 

•  s . 1 . 6  scat_pulse 


Procedure  name;  scat  pulse 


Author 


J.C.  Biard 


discussion  :  This  procedure  produces  a  numerical  solution  of 

the  equation  for  a  line-source  SH  seismic  wave  propagating  in 
a  dispersive  absorptive  half-space  having  a  surface  layer  as 
expressed  by  Equition  (l^Sa)  in  Volume  I.  The  wave  scatters  from 
an  Infinite  cylirnlrical  cavity  of  radius,  a,  located  yc  meters  below 


c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 


the  half-space  surface.  The  source  and  detection  points  are  located 
In  the  region  below  the  surface  layer.  At  the  detection  point  the  i 
time  domain  signal  for  the  scattered  wave,  including  nrefl  pre-  | 

scattering  and  nrefl  post-scattering  reflections  from  the  surface  | 

layer  boundary  and  the  half-space  boundary,  is  calculated  using  a  | 

high-frequency  limit  approximation  formula.  The  results  are  reportetjl 
in  the  array  wave.  t 

To  calculate  a  signal  in  the  time  domain,  the  frequency  domain 
transfer  function  is  calculated  and  converted  into  the  time  domain 
impulse  response  for  the  propagation  path.  This  is  then  convolved 
with  the  initial  signal  to  produce  the  signal  at  the  detector. 

This  process  is  repeated  for  the  direct  wave  and  all  allowed 
reflections.  These  time  domain  signals  are  then  summed  together 
to  present  the  final  signal. 

The  transfer  function  that  is  calculated  is  multiplied  by 
j  *  omega  before  the  Fourier  transform  in  order  to  obtain  the 
time  derivative  of  the  displacement  amplitude  signal  upon 
convolving  with  the  initial  signal.  The  resulting  particle 
velocity  signal  is  the  signal  most  often  presented  in  seismic 
studies . 


Procedures  called  from  this  module: 

fft2c  IMSL  subroutine  to  calculate  the  Fourier  transform, 
jhc  subroutine  to  calculate  Bessel  and  Hankel  functions, 

pulse  function  to  calculate  the  original  signal, 

zk  function  to  calculate  the  complex  wavenumber. 

Formal  arguments: 

Input ; 

xs  X  position  of  the  line  source, 

ys  Y  position  of  the  line  source. 

X  X  position  of  the  detector, 

y  Y  position  of  the  detector. 

scale  Scale  factor  to  apply  to  the  output  waveform. 

Output : 

t  Time  value  of  the  initial  element  of  the  output  array, 

wave  Array  of  the  particle  velocity  signal  waveform  values. 

External  variables: 

nrefl  Number  of  reflection  waves  to  calculate.  (0<=nref 1<=6) 

pi  Pi. 

h  Thickness  of  the  surface  layer,  (m) 

cl  Sll-wave  velocity  in  the  surface  layer,  (m  /  s) 

rhol  Density  of  the  surface  layer,  (kg  /  m) 

c2  SH-wave  velocity  in  the  lower  region,  (m  /  s) 

rho2  Density  in  the  lower  region,  (kg  /  m) 

a  Radius  of  the  cavity,  (m) 

alpha  Shape  factor  for  the  incident  pulse. 

wO  Peak  radial  frequency  for  the  Incident  pulse, 

df  Frequency  step.  (Hz) 
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non  o  o  o  o 


c 

xc 

X  position  of  the  cavity  center. 

c 

yc 

Y  position  of  the  cavity  center. 

c 

ql 

Quality  factor  for  the  surface  layer. 

c 

wl 

Cutoff  radial  frequency  for  the  surface 

laye  r . 

c 

q2 

Quality  factor  for  the  lower  region. 

c 

w2 

Cutoff  radial  frequency  for  the  lower  region. 

c 

hnkrs 

Array  of  variables  made  external  to  save 

raemoiry . 

c 

hnkr 

Array  of  variables  made  external  to  save 

me mo  ry « 

subroutine  scat_pulse (xs ,  ys ,  x,  y,  scale,  t,  wave) 
implicit  none 


real*8  xs,  ys,  x,  y,  scale,  t,  wave(A096) 
integer*4  nrefl 

real*8  pi,  h,  cl,  rhol,  c2,  rho2,  a,  alpha,  wO,  df,  xc,  yc ,  ql, 
1  wl,  q2,  w2 


common  /constants/  nrefl,  pi,  h,  cl,  rhol,  c2,  rho2,  a, 

1  alpha,  wO,  df,  xc,  yc,  ql,  wl ,  q2,  w2 


integer*4 

real*8 

real*8 

real*8 

complex*16 

coraplex*16 

coraplex*16 

conplex*16 

complex*16 


1,  n,  j,  1,  nr,  nrs,  virgin,  ier,  m,  work(9) 
dt,  dk,  sum,  k,  tdy ,  c,  cs,  phis,  phi,  theta 
acc,  accl,  w,  v,  u,  tsi2,  acc2 
pwave(256),  twave(256) 

k2,  z,  dispi,  ij ,  aj ,  ka,  krs,  kr,  nu,  r,  rs ,  cnr, 
s,  ss,  b 

Crndsp(l28),  spect(256),  hnka(0:50) 
hnkrs(0:49,2; 128,0:5),  hnkr(0:49,2: 128,0:5) 
jnka(0:50),  jpka(0:49,2:  128),  hpka(0:49,2: 128) 


cnrs 


common  /hankel/  hnkrs,  hnkr 


save  jpka,  hpka 

real*8  pulse,  zatan 
complex*16  zk,  znu 

equivalence  (trndsp(l),  specc(l)) 

znu(k)  -  zk(l,  k  *  c2  /  cl)  /  zk(2,  k) 

zatan(s,  x)  »  .5  *  (datan2(dble(s) ,  (x  +  dimag(s))) 

^  +  datan2(dble(s) ,  (x  -  dlmag(s)))) 


Initialize  local  constants 

data  virgin  /  0/ 
data  m  /  8/ 
data  acc  /  .0001/ 


Hi: 


ij  =  dcinplx(0.  ,  1 .  ) 

dt  =  1.  /  (256.  *  df) 
dk  =  df  *  2  *  pi  /  c2 
u  =  h  /  (abs(yc)  -  h) 
c  =  X  -  xc 
cs  =  xs  -  xc 

tsi2  =  (cl**2  *  rhol)  /  (c2**2  *  rho2) 

C 

C  Zero  the  output  array. 

C 

do  1  =  1,  4096 
wave(i)  =  0. 
end  do 
C 

C  Generate  the  pulse  waveform. 

C 

do  1  =  1,  256 

V  =  dbled  -  1)  *  dt 
pwave(l)  =  pulse(v) 
end  do 
C 

C  Calculate  the  Initial  path  length  time  offset. 

C 

k  =  128.  *  dk 

r  =  sqrt((x  -  xc)**2  +  (y  -  yc)**2) 

rs  =  sqrt((xs  -  xc)**2  +  (ys  -  yc)**2) 

t  =  d51e((rs  +  r)  *  zk(2,  k))  /  k  /  c2  -  20.  *  dt 

C 

C  Get  the  scattering  coefficients  for  the  cavity. 

C 

if  (virgin  .eq.  0)  then 
virgin  =  1 
do  i  =  2,  128 

k  =  dble(i-l)  *  dk 
k2  =*  zk(2,  k) 
ka  =  k2  *  a 

call  jhc(ka,  51,  jnka,  hnka) 
do  j  =  0,  49 

jpk3(j,i)  =  dble(j)  *  jnka(j)  -  ka  *  jnka(j+l) 
hpka(j,i)  =  dble(j)  *  hnka(j)  -  ka  *  hnka(j+l) 
end  do 
end  do 
end  if 
C 

C  Calculate  the  Hankel  functions  used  in  the  field  equation. 
C  This  is  done  to  prevent  recalculation  later. 

C 

C 

C  hoop  over  the  direct  term  and  the  ii  imber  of  reflections. 

C 

do  nrs  =  C,  nrefl 
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C 

Get  the  direct  source-scatterer  and  detector-scatterer  distances. 

if  (nrs  .eq.  0)  then 
ss  =  ys  -  yc 
rs  =  sqrt(cs**2  +  ss**2) 
s  =  y  -■  yc 

r  =  sqrt(c**2  +  s**2) 
end  if 

Loop  over  the  wavenumber  from  dk  to  127  *  dk. 

do  i  =  2,  128 

k  =  dble(l-l)  *  dk 
k2  =  2k(2,  k) 

Get  the  reflected  source-scatterer  and  detector-scatterer  distances. 

if  (nrs  .gt.  0)  then 
nu  =  2nu(k) 

ss  =  -(ys  +  yc  +  2,d0  *  (l.dO  -  '3ie(nrs-l)  *  nu)  *  h) 
rs  =  2sqrt(cs**2  +  ss**2) 

s  =  -(y  +  yc  +  2.d0  *  (l.dO  -  dble(’"rs-l)  *  nu)  *  h) 
r  =  zsqrt(c**2  +  s**2) 
end  if 

krs  =•  k2  *  rs 
kr  =■  k2  *  r 

Calculate  the  Hankel  function  values. 

call  jhc(krs,  50,  jnka,  hnkr3(0, i ,nrs  )  ) 
call  jhc(kr,  50,  jnka,  hnkr (0 , i , nrs ) ) 
end  do 
end  do 

Begin  the  Solution. 

Loop  over  the  direct  and  all  the  reflection  terms  for  the  source, 
do  nrs  =  0,  nrefl 

Get  the  direct  source-scatterer  distance  and  angle. 

Set  the  source-scatterer  amplitude  factor. 

if  (nrs  .eq.  0)  then 
ss  “  ys  -  yc 
rs  “  sqrt(cs**2  +  ss**2) 
phis  =  zatan(ss,  cs) 
cnrs  =  l.dO 
end  if 

Loop  over  the  direct  and  all  the  reflection  terms  for  the  detector, 
do  nr  »  0,  nrefl 
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Get  the  direct  detector-scatterer  distance  and  angle. 

Set  the  detector-scatterer  amplitude  factor. 

if  (nr  .eq.  0)  then 
s  =  y  -  yc 

r  =  sqrt(c**2  +  s**2) 
phi  “  zatan(s,  c) 
cnr  =  l.dO 
end  if 

Loop  over  the  wavenumber  values  from  0.  to  127  *  dk 

do  1  =  1,  128 

k  =  dbled  -  1)  *  dk 
k2  =  zk(2,  k) 
if  (i  .eq.  1)  then 
nu  =  c2  /  cl 
else 

nu  =  znu(k) 
end  if 

b  =  (tsi2  *  nu  -  l.dO)  /  (tsi2  *  nu  +  l.dO) 

Get  the  reflected  source-scatterer  distance  and  angle. 

Set  the  source-scatterer  amplitude  factor. 

if  (nis  .gt.  0)  then 

ss  =  -(ys  +  yc  +  2.d0  *  (l.dO  -  dble(nrs-l)  *  nu)  *  h) 
rs  =  zsqrt(cs**2  +  ss**2) 
phis  =  zatan(ss,  cs) 
if  (nrs  .eq.  1)  then 
cnrs  =  -b 
else 

cars  ^  b**(nrs-2)  *  (l.dO  -  b**2) 

1  *  zsqr t ( ( 1 .dO+u*nu*dble (nr s-1 ) ) 

2  /  (1 .dO+u*dble(nrs-l )/nu)) 
end  if 

end  if 
C 

C  Get  the  reflected  detector-scatterer  distance  and  angle. 

C  Set  the  detector-scatterer  amplitude  factor. 

C 

if  (nr  .gt.  0)  then 

s  =  -(y  +  yc  +  2.d0  *  (l.dO  -  dble(nr-l)  *  nu)  *  h) 
r  =  zsqrt(c**2  +  s**2) 
phi  =  zatan(s,  c) 
if  (nr  .eq.  1)  then 
cnr  =  -b 
el  se 

cnr  =  b**(nr-2)  *  (l.dO  -  b**2) 

1  *  zsqr t ( ( 1 .dO+u*nu*dble (nr-1 ) ) 

2  /  ( 1 .d0+u*dble (nr-1 )/nu ) ) 
end  if 

end  if 
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C  Ge-  scattered  field  value. 

C 

krs  =  k2  *  rs 
kr  =  k2  *  r 
theta  =  phis  -  phi 
C 

C  Do  the  scattered  field  transfer  function  summation. 
j=0  term  of  the  summation. 

j  =  0 

if  (k  .eq.  0.)  then 
dispi  =  0. 
else 

aj  =  jpka(j,l)  /  hpka(j,l) 

1  *  hnkrs( j , 1 ,nrs )  *  hnkr(j,l,nr) 

dispi  =■  aj 
end  i  f 


Calculate  the  j=l  through  J=n  terras 

acc2  =  0. 
do  j  =  1,  49 


Calculate  the  jth  term  of  the  sum. 


I 


C 

C 

c 


1 

1 


if  (k  .eq.  0.)  then 

z  =  -ij  *  cos(dble(j)  *  theta) 

/  (rs  *  r  /  a**2)**j  /  dble(j) 

else 

aj  =  2.d0  *  jpka(j,i)  /  hpka(j,i) 

*  hnkrs ( j , i ,nrs)  *  hnkr(j,i,nr) 
z  =  aj  *  cos(dble(j)  *  theta) 
end  if 


Add  the  jth  term  to  the  sum. 


C 

C 

c 


I 


dispi  =  dispi  +  z 

Determine  the  accuracy  level  for  the  sum  with  j  terms. 

if  (abs(displ)  .eq.  0.)  then 
accl  =  acc 
else 

accl  =  abs(z)  /  abs(displ) 
end  if 

Test  for  convergence 
n  “  j 

if  (accl  .le.  acc  .and.  acc2  ,le.  acc 
1  .and.  j  .ge.  10)  go  to  10 


K  accl  “  accl 

W  end  do 

f 


H-41 


rtoo  ooonoo  non  ono  oononoo  oo 


C 

Flag  non-convergence  error. 

write(7,  2000)  acc,  accl 
10  continue 

dispi  •  -Ij  *  pi  *  cnr  *  cnrs  *  dispi 

The  next  statement  is  for  calculating  particle  velocity  seismograms. 

To  calculate  displacement  seismograms,  comment  the  statement. 

dispi  =  -ij  *  dispi  *  c2  *  k 

Apply  partial  normalization  and  add  the  term  to  the  transfer  function, 

if  (k  .eq.  0.)  then 

dispi  =  dispi  /  c2**2 
else 

dispi  =  dispi  *  (dble(k2)  /  k  /  c2)**2 
end  if 

trndsp(i)  =  dispi 
end  do 

Remove  path  length  time  delay  from  the  transfer  function. 

k  =  127. dO  *  dk 
k2  =  zk(2,  k) 

tdy  =•  dble((rs  +  r)  *  k2)  /  k  /  c2  -  20.  *  dt 
V  “  dk  *  c2  *  tdy 
do  1  =  1,  128 

k  =  dble(i  -  1)  *  V 

trndsp(l)  =  trndsp(l)  *  zexp(-ij  *  k) 
end  do 

Force  the  high  k  values  to  zero. 

j  =  5.  /  dk 
w  “  128.  *  dk  -  5. 
do  1  -  j,  128 

V  =  1  *  dk  -  5. 

trndsp(l)  =  trndsp(l)  *  (1.  +  cos(v  *  pi  /  w))  /  2. 
end  do 

Generate  the  full  complex  spectrum  and  conjugate  it  to  prepare  for  the 
back  transform. 

Reflect  the  spectrum  for  negative  frequencies, 
do  1  “  2,  128 

spect(258-l)  =  conjg(trndsp(l)) 
end  do 

spect(129)  =  0. 

Conjugate  the  full  spectrum. 
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c 

c 

c 


c 

c 

c 


do  1  =  1,  256 

spect(l)  =  conjg(spect(l)) 
end  do 

Inverse  Fourier  transform. 

call  fft2c(spect,  m,  work) 

Conjugate  and  normalize, 
do  1  =  1,  256 

spect(l)  =  df  *  conJgCspectd)) 
end  do 

Convolve  the  pulse  and  the  transfer  function,  and  normalize. 

do  1  =  1,  256 
sum  =  0. 
do  j  =  1.  1 

sum  =  sum  +  pwave(l  -  j  +  1)  *  dble(spec t ( j ) ) 
end  do 

twave(l)  =  scale  *  sura  *  dt  /  (4.  *  pi  *  rho2) 
end  do 

Find  Che  time  offset  and  add  the  pulse  to  the  time  domain  signal. 

1  -  (tdy  -  c)  /  dt 
do  1  -  1,  256 

If  (I  +  i  .ge.  1)  then 

wave(I  +  1)  =  waved  +  1)  +  twave(l) 
end  if 
end  do 
end  do 
end  do 
return 


2000  formatC'Convergence  failed.  Limit  =  ",gl4.6,",  value  =  ",gl4.6) 


*^•2.1.7  scat_pulse2 


C 

^  Procedure  name:  scat_pulse2 

^  Author  :  J.C.  Blard 

^  Discussion  :  This  procedure  produces  a  numerical  solution  of 

^  the  equation  for  a  line-source  SH  seismic  wave  propagating  in 

^  a  dispersive  absorptive  half-space  having  a  surface  layer  as 

expressed  by  Equation  (165)  in  Volume  I.  The  wave  scatters  from 
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C  an  infinite  cylindrical  void  of  radius  a  located  yc  ineters  below 

C  the  half-space  surface.  The  source  point  is  located  in  the  region 

C  below  the  surface  layer  and  the  detector  point  is  located  at  the 

C  surface  of  the  the  half-space.  At  the  detection  point  the  tinie 

C  domain  signal  for  the  scattered  wave,  including  nrefl  pre- 

C  scattering  and  nrefl  post-scattering  reflections  from  the  surface 

C  layer  boundary  and  the  half-space  boundary,  is  calculated  using  a 

C  high-frequency  limit  approximation  formula.  The  results  are 

C  reported  in  the  array  wave. 

C  To  calculate  a  signal  in  the  time  domain,  the  frequency  domain 

C  transfer  function  is  calculated  and  converted  into  the  time  domain 

C  impulse  response  for  the  propagation  path.  This  is  then  convolved 

C  with  the  initial  signal  to  produce  the  signal  at  the  detector. 

This  process  is  repeated  for  the  direct  wave  and  all  allowed 
reflections.  These  time  domain  signals  are  then  summed  together 
to  present  the  final  signal. 

The  transfer  function  that  is  calculated  is  multiplied  by 
j  *  omega  before  the  Fourier  transform  in  order  to  obtain  the 
time  derivative  of  the  displacement  amplitude  signal  upon 
convolving  with  the  initial  signal.  The  resulting  particle 
velocity  signal  is  the  signal  most  often  presented  in  seismic 
studies. 

Procedures  called  from  this  module: 


fft2c  IMSL  subroutine  to  calculate  the  Fourier  transform, 
jhc  subroutine  to  calculate  Bessel  and  Hankel  functions, 

pulse  function  to  calculate  the  original  signal, 

zk  function  to  calculate  the  complex  wavenumber. 

Formal  arguments: 

Input : 

xs  X  position  of  the  line  source, 

ys  Y  position  of  the  line  source. 

X  X  position  of  the  detector. 

scale  Scale  factor  to  apply  to  the  output  waveform. 

Output : 

t  Time  value  of  the  initial  element  of  the  output  array, 

wave  Array  of  the  particle  velocity  signal  waveform  values. 


External  variables: 


C 

C 

C 


nrefl  Number  of  reflection  waves  to  calculate.  (0<=nref 1<=6) 

pi  Pi. 

h  Thickness  of  the  surface  layer,  (m) 

cl  SH-wave  velocity  in  the  surface  layer,  (m  /  s) 

rhol  Density  of  the  surface  layer,  (kg  /  m) 

c2  SH-wave  velocity  in  the  lower  region,  (m  /  s) 

rlio2  Density  in  the  lower  region,  (kg  /  m) 

a  Radius  of  the  cavity,  (ra) 

alpha  Shape  factor  for  the  incident  pulse. 

wO  Peak  radial  frequency  for  the  Incident  pulse. 
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n  n  a 


df 

xc 
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c 

c 

c 

c 

c 

c 

c 

c 

c 


yc 

q  1 

wl 

q2 

w2 

hnkrs 

hnkr 


Frequency  step.  (Hz) 

X  position  of  the  cavity  center. 

Y  position  of  the  cavity  center. 

Quality  factor  for  the  surface  layer. 

Cutoff  radial  frequency  for  the  surface  layer. 
Quality  factor  for  the  lower  region. 

Cutoff  radial  frequency  for  the  lower  region. 
Array  of  variables  nuide  external  to  save  meniory. 
Array  of  variables  made  external  to  save  memory. 


subroutine  scat_pulse2(xs ,  ys,  x,  scale,  C,  wave) 
implicit  none 


real*8  xs ,  ys ,  x,  scale,  t,  wave(4096) 
integer*^  nrefl 

real*8  pi,  h,  cl,  rhol,  c2,  rho2,  a,  alpha,  wO,  df,  xc,  yc ,  ql, 
1  wl,  q2,  w2 

common  /constants/  nrefl,  pi,  h,  cl,  rhol,  c2,  rho2,  a, 

I  alpha,  wO,  df,  xc,  yc,  ql,  wl,  q2,  w2 

integer*4  i,  n,  j,  1,  nr,  nrs,  virgin,  ier,  m,  work(9) 

real*8  dt,  dk,  sum,  k,  tdy,  c,  cs 

real*8  acc,  accl,  w,  v,  u,  tsi2 

real*8  acc2,  us,  phi,  phis,  theta 

real*8  pwave(256),  twave(256) 

complex*16  nu ,  r,  rs,  s,  ss,  cnr,  cnrs 

coraplex*16  k2,  z,  dlspi,  ij ,  aj ,  ka ,  krs,  kr,  b 

coraplex*16  Crndsp(128),  spect(256),  hnkafOiSO) 

complex*16  hnkrs (0 : 49 , 2 :  1 28 ,0; 5 ) ,  hnkr(0:49,2: 128,0; 5) 

coraplex*16  Jnka(0;50),  Jpka(0 : 49 , 2 : 1 28) ,  hpka(0: 49, 2 : 1 28 ) 

common  /hankel/  hnkrs,  hnkr 

save  jpka,  hpka 

equivalence  (trndsp(l),  spect(l)) 

real*8  pulse,  zatan 

complex*16  zk,  znu 

znu(k)  -  zk(l,  k  *  c2  /  cl)  /  zk(2,  k) 

2atan(s,  x)  ■  .5  *  (datan2(dble(s),  (x  +  dlraag(s))) 

I  +  datan2 (dble(s) ,  (x  -  dlmag(s)))) 


Initialize  local  constants. 

data  virgin  /  0/ 
data  m  /  8/ 
data  acc  /  .0001/ 
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i j  =  dcmplx(0. ,  1 . ) 

dt  =  1.  /  (256.  *  df) 

dk  =  df  *  2  *  pi  /  c2 

us  =  h  /  (abs(yc)  -  h) 

u  =  h  /  (2.d0  *  abs(yc)  -  h) 

c  =  X  -  xc 

cs  =  xs  -  xc 

tsi2  «  (cl**2  *  rhol)  /  (c2**2  *  rho2) 

Zero  the  output  array. 

do  i  =  1,  4096 
wave(i)  =  0. 
end  do 

Generate  the  pulse  waveform, 
do  1  =  1,  256 

V  =  dbled  -  1)  *  dt  \ 

pwave(l)  =  pulse(v) 
end  do 

Get  the  scattering  coefficients  for  the  tunnel. 

If  this  is  the  first  call  to  the  subroutine,  then  calculate  the  coefficients 

if  (virgin  .eq.  0)  then 
virgin  *•  1 

Loop  over  wavenumbers  from  dk  to  127.  *  dk. 

do  i  ”  2,  128 

k  =■  dble(i-l)  *  dk 

Get  the  complex  wave  number. 

k2  »  zk(2,  k) 
ka  =  k2  *  a 

Find  the  values  of  the  Bessel  and  Hankel  functions  for  the 
argument  ka. 

call  jhc(ka,  51,  jnka,  hnka) 

Calculate  the  coefficients  from  the  Bessel  and  Hankel  functions, 
do  J  ”  0,  49 

jpka(j,i)  =  dble(j)  *  jnka(j)  -  ka  *  jnka(j+l) 
hpka(j,l)  =  dble(j)  *  hnka(j)  -  ka  *  hnka(j+I) 
end  do 
end  do 
end  if 
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Calculate  the  Hankel  function  values  used  in  the  solution  for 

the  scattered  field.  This  is  done  in  advance  to  save  execution 
time. 


Loop  over  the  direct  and  all  image  terms, 
do  nrs  =  0,  nrefl 

Get  the  direct  source-scatterer  distance. 


if  (nrs  .eq.  0)  then 
ss  =  ys  -  yc 

rs  “  zsqrt(cs**2  +  ss**2) 
end  if 


Loop  over  wavenumber  values  from  dk.  to  127.  *  dk. 


do  1  -  2,  128 

k  -  dble(l-l)  *  dk 


Get  the  complex  wavenumber. 


k2  ”  2k(2,  k) 
nu  =■  znu(k) 


Calculate  the  source-scatterer  distance  with  nrs  reflections. 


if  (nrs  .gt.  0)  then 

ss  “  -(ys  +  yc  +  2.d0  *  (l.dO  -  dble(nrs-l)  *  nu)  *  h) 
rs  =•  zsqrt(cs**2  +  ss**2) 
end  if 


Calculate  the  detector-scatterer  distance  with  nrs  reflections. 


s  “  -(h  +  yc  -  (l.dO  +  2.d0  *  dble(nrs))  *  nu  *  h) 
r  ”  zsqrt(c**2  +  s**2) 
krs  =  k2  *  rs 
kr  =  k2  *  r 


Find  the  Hankel  function  values  for  the  arguments  krs  and  kr. 


call  jhc(krs,  50,  jnka,  hnkrs(0,i ,nrs)) 
call  jhc(kr,  50,  jnka,  hnkr (0, i ,nr3 ) ) 
end  do 
end  do 


Begin  the  solution. 

Loop  over  all  the  direct  and  reflection  terras  for  the  source, 
do  nrs  «  0,  nrefl 
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C  Calculate  the  direct  source-scat terer  distance,  ancle,  and  anplit ade  factr 
C 

if  (nrs  .eq.  0)  then 
ss  =  ys  -  yc 

rs  =  zsqrt(cs**2  +  ss**2) 
phis  =  zatanCss,  cs) 
cnrs  =  l.dO 
end  if 
C 

Loop  over  all  the  direct  and  reflection  terms  for  the  detector. 

do  nr  =  0,  nrefl 
C 

C  Calculate  values  for  0.  <=  ka  <=  (nk  -  l)*dka,  stepping  by  dka. 

C 

d  o  i  =  1 ,  128 

k  =  dble(i  -  1 )  *  dk 
k2  =  zk(2,  k) 
if  (k  .eq.  0)  then 
nu  =  c2  /  cl 
else 

nu  =  znu(k) 
end  if 

b  =  (tsi2  *  nu  -  l.dO)  /  (tsi2  *  nu  +  l.dO) 

C 

C  Calculate  the  source-scat terer  distance,  angle,  and  amplitude  factor 
C  with  nrs  reflections. 

C 

if  (nrs  .gt.  0)  then 

ss  =  -(ys  +  yc  +  2.d0  *  (l.dO  -  dble(nr5-l)  *  nu)  *  h) 
rs  =  zsqrt(cs**2  +  ss**2) 
phis  -  zatan(ss,  cs) 
if  (nrs  .eq.  1)  then 
cnrs  =  -b 
e  Ise 

cnrs  =  b**(nrs-2)  *  (l.dO  -  b**2) 

1  *  zsqr t ( ( 1 •d0+us*nu*dble (nr s- 1  )  ) 

2  /  ( ! . d0+us*dble ( nrs-1 ) /nu  )  ) 
end  if 

>.-nd  if 
C 

C  Calculate  the  detector-scatterer  distance,  angle,  and  amplitude  factor 
C  with  nr  reflections. 

C 

s  =  -(h  +  yc  -  (l.dO  +  2.d0  *  dble(nr))  *  nu  *  h) 
r  =  zsqrt(c**2  +  s**2) 
phi  =  zatan(s,  c) 

cnr  =  b**nr  *  4.d0  /  (tsi2  *  nu  +  l.dO) 

1  *  zsq  r  t  (  (  1  .  d0+u*iiu*  (  1 .  dO  +  2.d0  *  dble(nr))) 

2  /  (1 .d0+u*(! .dO  +  2.d0  *  dble(nr))/nu)) 
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ed  field  valii'^. 


C 

C  Get  sccir '  e  r 
C 

krs  =  k.2  *  rs 
kr  =  k2  *  r 
theta  =  phis  -  phi 
C 

C  Begin  sunnation  of  the  scattered  field  terms. 

C 

C  j=0  terra  of  the  sunrnation 
C 

j  =  0 

if  (k  .eq.  0.)  then 
dispi  =  0. 
else 

aj  =  jpka''  /  /  hpka(j,i) 

1  *  hn'.r’  j,i,nrs)  *  hnkr(j,i,nr) 

dispi  - 
end  if 
C 

C  Calculate  the  j=l  through  j=n  terras. 

C 

acc2  =  0. 
do  j  =1,  49 
C 

C  Calculate  the  Jth  terra  of  the  sun. 

C 

if  (k  .eq .  0. )  then 

z  =  -ij  *  cos(dble(j)  *  theta) 

1  /  (rs  *  r  /  a**2)**j  /  dble(j) 

else 

aj  =  2.d0  *  jpka(j,i)  /  hpka(j,i) 

1  *  hnkrs ( j , i ,nrs )  *  hnkr(J,i,nr) 

z  =  aj  *  cos(dble(j)  *  theta) 
end  if 


C 

C 

C 

c 

C 


c 

c 

c 


Add  the  jth  terra  to  the  sun. 

dispi  =  dispi  +  l 

Determine  the  accuracy  level  for  the  sun  with  j  terras 

If  (abs(dispi)  .eq.  0.)  then 
accl  =  acc 
else 

accl  =  abs(z)  /  abs(dispi) 
end  if 


Test  for  convergence. 


n  =  j 

if  (accl  .le.  acc  .and.  acc2  .le.  acc 

.and.  j  .ge.  10)  go  to  10 


oo  onn  ono  ooooo 


a  c  c  2  =  a  c  c  1 
end  do 
C 

C  Flag  non-convergence  error. 

C 

write(7,  2000)  acc,  accl 
10  continue 

dispi  =  -ij  *  pi  *  cnr  *  cnrs  *  dispi 
C 

C  The  next  statement  is  for  calculating  particle  velocity  seisnograns. 

To  calculate  displacement  seismograms,  comment  the  statement. 

dispi  =  -ij  *  dispi  *  c2  *  k 

Apply  partial  norma'’ ization  and  add  the  term  to  the  transfer  arra 

if  (k  .eq .  0. )  then 

dispi  =  dispi  /  c2**2 
else 

dispi  =  dispi  *  (dble(k2)  /  k  /  c2)**2 
end  if 

trndsp(i)  =  dispi 
end  do 

Remove  path  length  time  delay  from  the  transfer  function. 

k  =  127. dO  *  dk 
k2  =  zk(2,  k) 

tdy  =  dble((rs  +  r)  *  k2)  /  k  /  c2  -  20.  *  dt 
if  (nr  .eq.  0  .and.  nrs  .eq.  0)  then 
t  =  tdy 
end  if 

V  =  dk  *  c2  *  tdy 
do  i  =  1 ,  128 

k  =  dble(i  -  1 )  *  v 

trndsp(I)  =  trndsp(i)  *  zexp(-ij  *  k) 
end  do 

Force  the  high  k  values  to  zero. 

j  =5.  /  dk 
w  =  128.  *  dk  -  5. 
do  1  =  j,  128 

V  =  1  *  dk  -  5. 

trndsp(I)  =  trnd-pd)  *  (1.  +  cos(v  *  pi  /  w))  /  2. 
end  do 

Generate  the  full  complex  spectrum  and  conjugate  it  to  prt-pare  for  the 
C  back  transform. 

C 
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C  Reflect  the  spectnu.i  for  aoj.itive  frequencies. 

C 

do  1  =  2,  128 

s pec t (258-1)  =  conjgC t rudsp( 1 ) ) 
end  do 

spect(129)  =  0. 

C 

C  Conjugate  the  full  spectrum. 

C 

do  1  =  1,  256 

spectd)  =  conjg(spect(l)) 
end  do 
C 

C  Inverse  Fourier  transform. 

C 

call  fft2c(spect,  m,  work.) 

C 

C  Conjugate  and  nor.nalize. 

C 

do  1  =  1,  256 

spect(l)  =  df  *  coajg(spect(l)) 
end  do 
C 

C  Convolve  the  pulse  and  the  transfer  functioi;,  and  normalit.e. 

C 

do  1  =  1,  256 
sun  =  0. 
do  j  =  1 ,  1 

sun  =  sun  +  pwaveCl  -  j  +  1)  *  dble( spec t ( j  ) ) 
end  do 

tw3ve(l)  =  scale  *  sum  *dt  /  (4.  *pi  *  rho2) 
end  do 
C 

C  Find  the  offset  into  the  array  and  add  the  pulse  to  the  time  domain  signal. 
C 

i  =  (tdy  -  t)  /  dt 
do  1  =  1 ,  256 

if  (1  +  i  .ge.  1)  then 

wave(l  +  i)  =  wave(l  +  i)  +  twave(l) 
end  if 
end  do 
end  do 
end  do 
return 

2000  format ( "Convergence  failed.  Limit  =  value  =  ",gl4.6) 

end 
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nonoonoonnonnnrioooooooriooonnoonnnooooo 


H.2.I.8  CorpIo_x  Fuiu'tion  ^ 
C 


c 

r 

Procedure  name: 

zk 

L. 

c 

p 

Author : 

J.C. 

Biard 

c 

Di scuss ion : 

This 

procedure  calculates  a  complex  wavenumber 

C  from  a  real  seed  wavenumber,  k,  using  Equation  (60)  in  Volume  1. 

C  This  complex  wavenumber  is  used  to  Introduce  dispersion  and 

attenuation  into  the  equations  in  which  the  results  are  used.  The 
complex  wavenumber  can  be  determined  for  either  of  two  diff'_rent 
media,  as  selected  by  the  index  n. 

The  real  part  of  the  complex  wavenumber  is  considered  to  be 
the  dispersive  wavenumber,  for  which  the  velocity  of  pr')p ’.-pit  i  on 
rises  with  the  natural  log  of  the  frequency.  The  imagin.uy  p.irt 
is  considered  to  be  the  attenuation,  and  rises  with  the  c  -i.-n  t  i  a  1 
of  the  frequency. 

The  calculations  of  the  complex  waver, uiriber  make  use  of  a 
threshold  radial  frequency,  wi ,  and  a  quality  factor, 
qi,  (i  =  1,  2).  Below  the  threshold  fr^.'quency,  there  is  no 
dispersion  or  attenuation.  The  quality  factor  is  a  unitless 
quantity  that  describes  the  magnitude  of  the  dispersion  and 
attenuation  in  a  given  medium. 

Procedures  called  from  this  Module: 

none 

Formal  arguments: 

Input : 

n  Tlie  m.i’dium  for  which  the  complex  wavenumber  is  to  be 

calculated . 

k  The  real  wavenumber,  which  is  used  as  a  seed  for  the 

complex  value. 

Output : 

zk  The  complex  w.ivenur.her . 

External  variables: 

nrefl  Number  'f  reflection  w.-iN-es  to  calculate.  (0<  =  nref  1<=6 ) 

pi  Pi . 

h  Thickness  of  the  surf.icc  layer,  (m) 

cl  SH-wave  velocity  in  the  surface  layer,  (ra  /  s) 

C  rhol  Density  of  the  surface  layer,  (kg  /  m) 

C  c2  SH  Mve  velocity  in  the  lower  region,  (m  /  s) 

C  rho2  Density  in  the  lower  region,  (kg  /  m) 

C  a  R.idius  of  the  c.ivity.  (m) 


n  r>  n 


r 


C 

C 

c 

c 

c 

c 

c 

c 

c 

c 


alph:  Shap:’  factor  for  the  incident  pulse. 

wO  Pea'-,  radi.il  frequency  for  the  incident  pulse. 

df  Frc.iue.icy  st’^p.  (az) 

xc  X  p.'sition  of  the  cavity  center. 

yc  Y  position  of  the  cavity  center. 

ql  Quality  factor  for  the  surface  layer. 

wl  Cutoff  radial  frequency  for  the  surface  layer. 

q2  Qrdity  factor  f''r  the  lower  region. 

w2  Cutoff  radial  frciiuency  for  the  lower  region. 


coinplex*16  function  z'<(n,  k) 

implicit  nop.o 

integer*-!  n 
r  e  a  I  *  8  k 

integer*!  nrefl 

real*3  pi,  h,  cl,  rhol,  c2,  rho2,  a,  alpha,  wO,  df,  xc ,  yc ,  ql, 
1  wl,  q2,  w2 

conmon  /constants/  nrefl,  pi,  h,  cl,  rhol,  c2,  rho2,  a, 

1  alph.i,  wO,  df,  xc,  yc ,  ql,  wl,  q2,  w2 

real *8  beta,  kp,  wp 


C 

C 

c 


c 

c 

c 

c 


I 


t. 


Calculate  the  complex  wavenunber  for  mediuni  1. 

if  (n  .eq.  1)  then 
wp  =  k  *  c  1  /  w  I 

If  the  wavenunber  is  over  threshold,  calcul.ite  the  now  velocity 
and  at  tenu  1 1 1'ln  . 

if  (wp  .ge.  1.)  then 

kp  =  k  *  (1.  -  log(wp)  /  pi  /  ql) 
beta  =  k  *  (1.  -  exp(— wp))  /  2.  /  ql 
else 

kp  =  k 
beta  =  0. 
end  if 
else 

Calculate  the  complex  wavenumber  for  medium  2. 
wp  =  k  *  c2  /  w2 

If  the  wivonumber  is  over  threshold,  calculate  the  new  velocity 
and  at  tenu i t ion . 

if  (wp  .g".  1.)  then 

kp  =  k  *  (1.  -  log(wp)  /  pi  /  q2) 
bora  =  k  *  (1.  -  exp(-wp))  /  2.  /  q2 

H  '1 


L 


T 


else 

kp  =  k 
beta  =  0. 
end  if 
end  if 

zk  =  dcraplx(kp,  beta) 
return 

end 


H.2.2  Data  Files 


A  sample  input  file  and  the  first  thirty  lines  of  the  resulting  output 
file  from  the  program  synseis  are  shown  below. 

H.2.2. 1  Sample  Input 

Below  is  a  sample  input  file  for  the  program  synseis.  The  first  line 
in  the  file  specifies  the  number  of  reflections  that  are  allowed  to  be  pro¬ 
cessed,  up  to  a  maximum  of  six.  For  a  value  of  0,  the  result  will  be  that  of 
an  infinite  space.  For  a  value  of  1,  the  result  will  be  that  of  a  half-space 
with  boundary  conditions  specified  by  other  parameters  in  the  file.  For  a 
value  of  2  or  greater,  the  program  will  model  a  half-space  with  a  surface 
layer. 


The  second  line  specifies  the  velocity  and  density  of  the  sur¬ 
face  layer. 

The  third  line  specifies  the  quality  factor  of  the  surface  layer 
and  the  cutoff  radial  frequency  of  the  lossy  behavior  of  the  surface  layer.  If 
the  cutoff  is  set  very  high,  the  surface  layer  will  be  lossless. 

The  fourth  line  specifies  the  velocity  and  density  of  the  lower 
region  of  the  half-space. 

The  fifth  line  specifies  the  quality  factor  of  the  lower  region 
and  the  cutoff  radial  frequency  of  the  lossy  behavior  of  the  lower  region.  If 
the  cutoff  is  set  very  high,  —10^®,  the  lower  region  will  be  lossless. 

The  sixth  line  specifies  the  peak  frequency,  in  Hertz,  and  the 
damping  rate  of  the  pulse.  A  value  of  .9  is  strongly  damped,  and  smaller 
values  will  cause  the  pulse  to  damp  more  slowly. 

The  seventh  line  specifies  the  step  in  frequency  to  use  in  all 
the  calculations  of  the  seismic  waves  in  the  frequency  domain.  This  value  is 
in  units  of  Hertz. 

The  eighth  line  specifies  the  radius  of  the  cavity  in  meters 
and  the  thickness  of  the  surface  layer  in  meters. 

The  ninth  line  specifies  the  location  of  the  cavity  in  a 
coordinate  system  in  which  the  half-space  surface  is  the  surface  at  y  =  0 
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meters  and  in  which  the  cavity  and  all  sources  and  detectors  must  be  in  th.e 
region  of  negative  y.  The  cavity  location  is  given  as  an  x,  y  pair,  anc'  it 
must  not  be  located  in  the  surface  layer,  which  is  considered  to  lie  in  the 
region  from  y  =  0  meters  to  y  =  -h  meters. 

The  tenth  line  specifies  the  source  location  in  the  coordinate 
systera  mentioned  above.  Like  the  cavity,  the  source  must  be  located  in  the 
lower  region. 

The  eleventh  line  specifies  the  starting  location  for  the  arra 
of  detectors  at  which  the  SH  wave  signal  Is  calculated.  This  array  is  consid¬ 
ered  to  run  parallel  to  the  x  axis.  The  array  must  be  located  in  the  lower 
region  or  on  the  surface  of  the  half-space,  at  y  =  0  meters. 

The  last  line  specifies  the  nurabei  of  detectors  present  in  the 
detector  array  and  the  spacing  between  the  detectors,  in  meters. 

The  example  below  is  an  exact  copy  of  the  input  file  used  with 
the  program  synseis  to  generate  the  output  in  the  next  section.  The  comments 
on  each  line  are  not  required,  but  may  be  there  without  disturbing  the  readin 
of  the  parameters  by  the  program.  The  numerical  values  must  be  presented  in 
the  order  and  on  the  lines  as  shown  below. 


3  S  No.  of  reflections.  (0=space,  l=l/2space,  >=2=layer 

300.,  1500.  $  Layer  1:  SH-wave  veloclty(m/s ) ,  dens  1 1  y  (kg/iii**3 ) . 

50.,  .05  $  Q  factor,  reference  radial  frequency. 

2500.,  2500.  $  Layer  2:  SH-wave  veloc I ty (m/s ) ,  dens i ty (kg/m**3 ) . 

100.,  .05  $  Q  factor,  reference  radial  frequency. 

1000. ,  .9  $  Pulse  peak  freq.,  damping  factor. 

39. 7887357 7d0  $  Frequency  step. 

1».  5.  $  Cavity  radius,  layer  depth  (h  >=  0.). 

0.,  -50.  S  Cavity  location  (x,  y). 

■32.,  -6.  S  Source  location  (x,  y). 

1*>  “0.  S  Detector  array  start  point  (x,y).  (y>-h  or  y=0) 

1>  1.  S  No.  of  detectors,  spacing. 

H • 2 . 2 . 2  Sample  Output 

The  output  below  is  an  exact  copy  of  the  output  generated  by  the  pro 
gra^:  synseis  when  the  input  file  is  the  one  shown  above.  The  listing  below 
^'^preseats  the  first  thirty  lines  of  the  output. 

1  ^096  3  5.0  500.0  1500.0  2500.0  2500.0  6283.185307179585800 
•900000000000000  39.788735770000002  9. 8 1  74 7 704320 187E-005  1.0 
0-OOOOOOOOOOOOOOE+OOO  -50.0  -52.0  -6.0  1.0  -6.0  50.0  5. OOOOOOOOOOOOOOE-002 
[00.0  5.00000000000000E-002  1.0 
1*0  1.83343267201207E-002  4.09793342635796E-002 

O.OOOOOOOOOOOOOOE+OOO  -9.86040601 7 163 5 7E-006  -3. 73468405469397E-005 
'^•4ll27820050589E-005  -1 . 050936 1 638007 1 E-004  -1 . 141 73362 35306 lE-004 
~9. I0977460277003E-005  -3.8947222551 554 9E-005  1.890220 7285 7 132E-00 5 
^•  1337/893894403E-005  4.2863740538401  lE-005  1 . 5750 1  38950 1  54 3K-005 
^•05l8534190l  528E-006  1 . 7209805 1  5 1 2  1 63E-005  -5.60444452 18384  I E-006 
'8.9195528872 7 7 54E -00 5  -1.3435371 5526207E-004  2. 096002462 7 5653E-004 


3. 1694:66167261 7E-00A  -6. 72339541 141 405E-004  6. 2843 1 4684362 39E-003 
3. 50344989238494E-002  7 .45644 1 3 1 7687 35E-002  8. 94S9962 54 542 35E-002 
5. 74394784148735E-002  -1 . 10606362 1291 91 E-002  -8. 32881 53561 3962E-002 
-.125481364557382  -.120064508309060  -7 . 1 96794 9607 1 384E-002 
-3.  5945721  31  141 78E-003  5. 70780 1488 1954  3E-002  8. 87  964  205 581 87 5E-002 
8.44691452417778E-002  5. 1 594066003761 3E -002  6. 857307 1 2687 943E-003 
-3. 18017360223787E-002  -5.20535645804432E-002  -5 . 056308572 767 3 7E-002 
-3.235592  567  75042E-002  -7 . 2688504272 1 200E-003  1.457413101  1 3301E-002 
2. 6399469 1 89 1793E-002  2 . 642 1 52694 1 8879E-002  1. 73436876261 574E-002 
4.38783468713455E-003  -7. 10772120059540E-003  -1 . 35689775237856E-002 
-1.40033764466985E-002  -9. 72365993731 303E-003  -3. 33190856932846E-003 
2. 4862 331 229322 5E-003  5. 90465102652766E-003  6. 36842672057483E-003 
4.46687408454538E-003  1 . 44550730598057E-003  -1 . 3848949958 1 388E-003 
-3. 1 12586 1259548 lE-003  -3. 43422291 666952E-003  -2 . 60189768768065E-003 
-1. 193o6238736904E-003  1 . 6762 79089581 56E-004  1 . 0372 73 764 3070 5E-003 
1.25286085709700E-003  9. 15473387332386E-004  2 . 86564 64 1 272 363E-004 
-3.42686667695489E-004  -7 . 58024277573733E-004  -8. 74601036794633E-:304 
-7.31383572196355E-004  -4. 4475822 338961 3E-004  -1 . 482443362 54 333E-004 
5.72093419695609E-005  1 . 2839962241 74 73E-004  7.88181 535909211E-005 
-4, 1068290671 7466E-005  -1 . 706743-46539787E-004  -2 . 65 1 4957 7682 53 7E-004 
-3.04561 2 14208585E-004  -2 . 90648806702587E-004  -2.40871 529364743E-004 
-1.7892221 36 72084E-004  -1 . 25704399895347E-004  -9. 37985761 31 0435E-005 
-8.63435174374761E-005  -9. 8895548000443 lE-005  -1 . 2228347 3354 508E-004 
-1. 4 5443228457 183E-004  -1 . 58950926514508E-004  -1 . 59127788009629E-004 
-1. 50338460309 153E-004  -1 . 404576261 77698E-004  -1 . 295684109351 22E-004 
-1.05941034393917E-004  -9. 351 44899234639E-005  -7.45475467 72 1 954E-005 
4. 7 195081 53588 15E-004  2. 54228770677183E-003  6.226627760851 43E-003 
9.66098601 708087E-003  1.01 4 14874 721 488E-002  6. 27 7 732832 76044E-003 
-9. 052781 89870855E-004  -8 . 5363 1 966598725E-003  -1 . 34643777973222E-002 
- 1.37 9678687 5 5026E-002  -9 . 65463042458288E-003  -2 . 9244322 1 3981 39E-003 
3.717^  84895  76844E-003  7. 96889631 308235E-003  8. 7  3284508063948E-003 
6.3424661 1993576E-003  2. 19481 784404365E-003  -1 . 9494786353S670E-003 
-4,6693541 31 781 74E-003  -5. 32398772451678E-003  -4. 12148366907896E-003 
- 1.868424693 3 1284E-003  4. 4057062 54 35726E-004  2.01082837235533E-003 
2.479455190S9527E-003  1 . 9436 1 050229078E-003  8. 21435863901 723E-004 
-3. 6679532 1252789E-004  -1 . 201 78960803560E-003  -1 .485181 79448b81E-003 
-1 .25434602070362E-003  -7 . 1 2334403280661 E-004  -1 .1793653561 3221E-004 
3.16357458824037E-004  4 , 85282246333699E-004  3. 99868929222058E-004 
1.544 7 5246850 195E-004  -1 , 26372315875142E-004  -3. 379907 5296 3346E-004 
-4.26034762024539E-004  -3. 91 997569976660E-004  -2 . 782665486 1 57 55E-004 
-1 .43 1448800698 7 9E-004  -3.697181  1439742  lE-005  1 . 2824  36  7  3593586r:-0O5 
5. 00642 18989800 lE-006  -4 . 1 92 1 4407 1 76348E-005  -1 .01 165464693355E-004 
-1 . 4889942 507 7008E-004  -1 . 7 1 54 305881 3405E-004  -1 . 67625900343532E-004 
-1 .4 504 1265844 154E-004  -1 . 1 5866230010875E-004  -9 . 1 1 6684 70429" 1 8E-005 
-7. 75455582 5839 15E-005  -7 . 6 1 1 75 1 2282 1 3 1 8E-005  -8. 36050544654 /95E-005 
-9.46222420438954E-005  -1 .0406494822572 1 E-004  -1 . 08764 7 343242 36E-004 
-1 .0803 1982 5237 74E-004  -1 .03204260996270E  004  -9. 66343329 190498E-005 
-9. 0624 15841 032 58E-005  -8 . 667 3096261 7657E-005  -3. 51 94832 1 790042E-005 
-8.566561 30558596E-005  -8. 70494844254843E-005  -8.82920652748231E-005 
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H. 3  Graphics  Programs 


This  section  contains  the  programs  and  subroutines  for  producing  graphics 
plots  of  the  data  computed  by  the  modeling  programs.  They  are  written  in  the 
C  language  to  allow  for  a  greater  flexibility  in  manipulating  the  data  and  to 
take  advantage  of  the  same  language  interface  allowed  in  the  use  of  the  star- 
base  graphics  package  subroutines,  which  are  also  written  in  C. 

The  main  program  segments  for  each  different  program  are  included  under 
separate  sections,  while  subroutines  common  to  all  the  programs  are  included 
in  another  section. 

H.3.1  Graphics  for  Plane  Wave  Results 

For  the  plane  wave  modeling  programs,  the  data  generated  by  each  pro¬ 
gram  was  different  enough  that  a  separate  graphics  program  was  written  for 
each  modeling  program.  Subroutines  common  to  all  of  these  programs  are 
included  in  Section  H.3.3. 

H.3,l.l  graph-csect 


Procedure  :  graph_csect 

Author  :  J.C.  Biard 

Discussion  : 

This  procedure  draws  plots  of  the  data  from  the  program  csect. 

Invocation 

The  procedure  is  run  by  typing 

graph_csect  ifile  gdev  gdriver 

where  ifile  is  the  data  file  output  by  csect,  gdev  is  the 
name  of  the  graphics  device  special  file,  and  gdriver 
is  the  driver  name  for  the  graphics  device. 

External  variables  :  none 

Procedures  called  from  this  module  : 
axis 

character_slze 
init_coords 
x_labels 
y_labels 
y_labels_r 

*/ 

'^include  <stdio.h> 

Include  <starbase.c.h> 


Draws  axes  and  tic  marks  for  the  plot. 

Sets  the  size  of  the  characters. 

Initializes  the  plotting  surface. 

Draws  x  axis  labels  and  titles  the  plot. 

Draws  y  axis  labels  to  the  left  of  the  axis. 
Draws  y  axis  labels  to  the  right  of  the  axis. 
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E,iin(argc,  argv) 
int  argc; 
char  *argv[]; 

{ 

char  *xtitle,  *ycitle,  *title; 

int  i,  n,  gfd; 

float  xl,  x2,  yl,  y2,  dum; 

float  wl ,  wr ,  wb,  wt ,  xstep,  ystep; 

float  line[250],  *aline,  extent[12]; 

double  k.a(125],  sigt(125l;; 

FILE  *fp: ; 

FILE  *fopen(); 


Open  the  input  data  file. 

*/ 

fp  =  fopen(argv  ( 1 1  ,  "r"); 

/* 

Read  the  data  frora  the  file  into  the  appropriate  arrays  until  the  end 
of  the  file. 

*/ 

n  =  0; 

while  (fscanf(fp,  "%lg%lg“*lg%*lg" ,  &ka[n),  &sigt[n])  >  0) 

{ 

n++; 

} 

/* 

Close  the  input  data  file. 

*/ 

f  close ( f  p ) ; 

/* 

Open  the  grapFiics  device  special  file  and  draw  the  axes  and  labels  on 
the  graphics  surface. 

*/ 

gfd  =  gopen  (argv[2],  OUTDEV,  argv[3],  RESET_DEV1CE | IN  IT ) ; 

wl  =  0.  ; 

wr  =  10.; 

wb  =  0. ; 

wt  =  2 . ; 

xstep  =  1 . ; 

ystep  =  .5; 

xtitle  =  "ka"; 

ytitle  =  "q"; 

title  =  "SH-WAVE  SCATTERING  CROSS-SECTION"; 
ini t_coords (gf d ,  wl ,  wb,  wr,  wt ,  .15,  .15,  .05,  .05); 
wc  to_vdc(gfd,  wl ,  wb,  0.,  6rxl,  &yl,  &dum); 
wc_to_vdc(gfd ,  wr,  wt ,  0.,  &x2,  &y2,  &dum); 
c li p_rec tang le (gfd ,  xl ,  x2,  yl,  y2); 
text_color  _inilex{gfd  ,  5); 

1 i ne  col or_index (gf d ,  5); 
axis(gfd,  0.,  0.,  xstep,  ystep); 

1 1 ne_color_i ndex (gfd ,  6); 
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tnove2d(gfd,  2.,  wb); 
draw2d(gfd,  2.,  wt ) ; 
move2d(gfd,  4.,  wb); 
draw2d(gf d ,  4. ,  wt ) ; 
move2d(gfd,  6.,  1.); 
draw2d(gfd,  6.,  wt ) ; 
move2d(gfd ,  8. ,  1 .  ) ; 
draw2d(gfd ,  8. ,  wt ) ; 
movo2d(gfd,  10.,  wb); 
draw2d(gfd ,  10. ,  wt ) ; 
move2d(gfd,  wl ,  .5); 
draw2d(gfd,  4.,  .5); 
move2d(gfd,  wl ,  1.); 
draw2d(gfd,  wr,  1.); 
move2d(gfd,  wl ,  1.5); 
draw2d(gfd,  wr ,  1.5); 
draw2d(gfd,  wl ,  2.); 
draw2d(gfd,  wr ,  2.); 
lino_color_index(gfd ,  5); 
character_size(gfd,  .05,  .5); 

lnquire_text_extent(gfd ,  "A",  WORLD_COORD[NATK_TEXl ,  exteat); 
xl  -  excent(9]  -  extenc(3l; 
yl  =  exCent[10l  -  extenc[4]; 

text_alignnent(gfd,  TA_LF.FT,  TA_B0TT0M,  0.,  0.); 
x2  =  4 .  +  xl ; 
y2  =  1.  -  3.  *  yl; 

test2d(gfd,  x2,  y2,  "TOrAL  RF.ELF.CTED  ENERGY",  W0RLD_C00RDlNArK  TEXT,  EAl. 
y2  -=  yl; 

text2d(gfd,  x2,  y2,  "PLANE  WAVE  SOURCE",  W0RL0_C00RDlNATE_TES T ,  FALSE); 
y2  -=  yl; 

char  .50  te r_s ize (gfd  ,  .06,  .5); 

tex’2d(gfd,  x2,  y2,  "a",  W0Rf.n_C00RDlNATE_TEXr,  FALSE); 
char  ac  t-- r_size  (gfd  ,  .05,  .5); 
x2  +=  xl; 

text2d(gfd,  x2,  yl,  "  =  1  METER",  W0RLD_C00R1UNATE_TEXT ,  FAI.SK); 
x2  --  xl; 
y2  -=  y  1  ; 

text2d(grd,  x2,  yl,  "V",  WORLD_COORn[NATE  TEXT,  FALSE); 
x2  +=  xl  ; 

text_aligunent(gfd ,  TA_LFFT,  TAJIALE,  0,,  0.); 
text2d(gfd,  x2,  yl,  "s',  WORLD_COORr)INATE_TEXT ,  FALSE); 
x2  +=  xl; 

textual Ignraent (gfd,  TA_LEFT,  TA_B0TT0M,  0.,  0.); 

t''xt2d(gfd,  x2,  yl,  "  =  2,500  m/s",  WORLD_COORr)[NATE_TEXT ,  FALSE); 
^.^l^hels  (gfd ,  0.,  0.,  xstep,  0.,  xstop,  wl,  wr,  "114. If",  xtitle,  title); 
y_^labels(gfd ,  0.,  0.,  ystep,  0.,  ystep,  wb,  wt ,  "%3.lf",  ytitle); 

Draw  the  cross-section  curve. 

aline  =  &Une[01  ; 

(i  =  0  ;  I  <=  n  ;  i  +  t) 


{ 

*al ine++  -  ka  [  i  ]  ; 

*a 1 i ne  +  +  =  &  i gt  [  i  1 ; 

} 

line_color_indox(gfd ,  2); 
polyline2d(gfd ,  line,  n,  FAI.^^E); 

/* 

Close  the  graphics  device. 

*/ 

gclose(gfd) ; 
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/* 

Procedure 
Aut  hor 


:  graphed i spa 
:  J.C.  Biard 


Discussion 

This  procedure  draws  plots  of  the  data  frora  the  program  dispa. 

Invocation  : 

The  procedure  is  run  by  typing 

graph_dispa  ifile  gdev  gdriver 

where  ifile  is  the  data  file  output  by  dispa,  gdev  is  the 
name  of  the  graphics  device  special  file,  and  gdriver 
is  the  driver  .ame  for  the  gr-iphics  device. 


External  Variables  :  none 


Procedures  called  from  this  module  : 


axis 

character__size 
i  n i t_coords 
x__'  abels 
y_labols 
y  labels  r 


Draws  axes  and  tic  marks  for  the  plot. 

Sets  the  si/.e  of  the  characters. 

Initializes  the  plotting  surface. 

Draws  x  axis  labels  and  titles  the  plot. 

Draws  y  axis  labels  to  the  left  of  the  axis. 
Draws  y  axis  labels  to  the  right  of  the  axis. 


/‘inclvidc  <stdio.h> 
^/include  <st  arhase  .  c  .h> 


nain(argc,  argv) 
int  argc; 
char  *argv(l; 

{ 

.'bar  *xtitle,  *ytitle,  title(132),  buffer[132],  *title2,  buffer2[80) 
int  i .  n ,  gf d  ,  virgin; 

float  xl ,  x2,  yl,  y2,  dum,  pi,  extent[12); 
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y  s  t  •  ■  p  ; 


flo’’  wl  ,  wr ,  wb ,  wt  ,  xst’p, 
floaf  1  i  nf  [  5i)i1  ]  ,  *aline; 
double  ki[2ail],  ar,ip[2S0],  ph  ..'[ySO]; 

FI[-K  *ip; 

char  *sCicpy(); 

FI.LF  *fopt  r'i(); 

pi  =  3.  U1  59265'*: 

title:  =  "SH-WAVF  SCALIFRING  VS.  FRFa^L'F.NCY" ; 
virgin  =  0; 

/■k 

Open  the  graphics  device  special  file  and  select  the  default  p.ns. 

*/ 

gfd  =  gopon(argv  [  2  ]  ,  OL'TOF.V,  argv[3l,  RK.SET__DEV  ICE  j  IN  1 1 ) ; 
text_color_index(gfd ,  5); 
line__co’ or_index(gfd  ,  5); 

/* 

Open  the  data  input  file. 

*/ 

fp  =  fopenCargv [  1  ]  ,  "r"); 

/* 

Read  one  line  of  data  at  a  tine  until  the  end  of  the  file. 

*/ 

while  (fscanf(fp,  "/I  ( A-Za-zO-9 , ,  +-=]'n",  buffer)  >  0) 

{ 

/* 

If  the  line  is  a  title  line,  get  the  title  or  plot  the  accumulated  dati. 

*/ 

if  (buffer[0l  ==  ’S') 

{ 

/* 

If  th-’s  is  the  first  title  line,  get  the  title  onlv. 

*/ 

if  (virgin  =“  0) 

{ 

fscaaf(fp,  nZ [ A-Za-zO-9 , .  +  -I'n",  title); 
s t rcpy ( t  i  t  le  ,  buffer); 
virgin  =  1 ; 

} 

/* 

If  this  is  not  the  first  title  lino,  plot  the  data. 

*/ 

else 


Get  a  new  graphics  surface  and  draw  tlie  axes  and  labels  for  the  amplitude 
part  of  the  plot. 

c  1  ea r_view_su r  f .tee  (gf  d  ) ; 
wl  =  0. ; 
wr  =  10. ; 
wb  =  0. ; 
wt  =  2.2001; 
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X  b  t  e  p  =  1 .  ; 

ystep  =  .2; 
xtitle  =  "ka"; 
vLitle  =  ''AMPi.ITL'DE"; 

i  ni  t_coor(’ b  (gf  d  ,  wl ,  wb,  wr,  wt ,  .15,  .15,  .18,  .05); 
wc_to_vdc(gfd ,  wl ,  wb,  0.,  &xl,  &yl,  idurn); 
wc_to_vdc(gfd ,  wr,  wt ,  0.,  &x2,  &y2,  &duni); 
clip_rectangle(gfd ,  xl,  x2,  yl,  y2); 
axis(gfd,  0.,  0.,  xstep,  ystep); 

x_labels(gfd ,  0.,  0.,  xstep,  0.,  xstep,  wl ,  wr ,  "%2.0f.", 
xtitle,  t i t le2 ) ; 

y_labels (gf d ,  0.,  0.,  ystep,  0.,  ystep,  wb ,  wt  ,  "%3.1f",  ytirle); 
textual  ignnent  (gfd ,  TA_LF,KT,  TA_BOTTOM,  0.,  0.); 
character_size(gfd ,  .05,  .5); 
sscanf (&t i t le [ 40 ] ,  "%f",  &xl); 

sprintf (buf fer2,  "PHI  =  %2.0f.  DEG.",  xl  *  180.  /  pi); 

i  nqui re_text_extent (gfd ,  "A",  WORLD_COORDI NATE  TEXT,  extent); 

xl  =  extent[9]  -  extent[3); 

yl  =  extent[10]  -  extent(4]; 

x2=0.  +2.  *xl; 

y2  =  .45; 

text  2d (gfd,  x2,  y2,  buffer2,  W0RLD_C00RD1 NATE_TEXT ,  FALSE); 
y2  -=  yl; 

character_size(gfd ,  .06,  .5); 

text2d(gfd,  x2,  y2,  "a",  W0RLD_C00RD1NATE_TEXT ,  FALSE); 
character_size (gfd ,  .05,  .5); 
x2  +=  xl; 

text2d(gfd,  x2,  y2,  ' 
x2  -=  xl ; 
y2  -=  yl; 

text2d(gfd,  x2,  y2,  "V",  WORLD_ronRD!  NM  :-;_Tr,XT ,  FALSE); 
x2  +=  xl ; 

textual ignnent (gfd ,  TA_LEFT,  TA_HALF,  0.,  0.); 

Cext2d(gfd,  x2,  y2,  "s",  W0RLD_C00RDINATE_TEXT ,  FALSE); 
x2  +=  xl ; 

t ext_al i gnmen t (gf d ,  TA_LEFT,  TA_B0TT0M,  0.,  0.); 

toxt2d(gfd,  x2,  y2,  "  =  2,500  m/s",  W0RLD_C00RD1NATE_TEXT,  FALSE 

y2  +=  yl; 
x2  =  8. ; 

text_al ignment (gfd ,  TA_R1GHT,  TA_BOTrOM,  0.,  0.); 
text2d(gfd,  x2,  y2,  "A>'P.  ",  WORLD_COORDINATE_TEXT,  FALSE); 

1  i  ne_color_i ndex (gf d ,  2); 
move2d(gfd,  x2,  y2  +  ,5  *  yl); 

draw2d(gfd,  9.,  y2  +  .5  *  yl); 

y2  -=  yl; 

t.xt2d(gfd,  x2,  y2,  "PHASE  ",  WORLD_COORDI NATE_TEXT ,  FALSE); 
line_color_ind  ■x(gfd  ,  3); 
move2d(gfd,  x2,  y2  +  .5  *  yl); 

draw2d(gfd,  9.,  y2  +  .5  *  yl); 

1  ine_color_  index(gfd ,  5); 


=  1  METER",  WORLD  COORDINATE  TEXT,  FALSE) 


Draw  the  amplitude  data  curve. 
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al  ine  =  ino [0 ] ; 
for(i=0;  i<=n;  i+^) 

{ 

*al  i  ne  +  I-  =  ka  [  i  ]  ; 

*al  tnc  +  t-  =  amp  [  i  ]  ; 

} 

line__color_index(gfd  ,  2); 
polyline2d(gfd ,  line,  n,  FALSi:); 

/* 

Draw  axes  and  labels  for  the  phase  part  of  the  plot. 

*/ 

line_color_index(gfd ,  5); 

wl  =  0. ; 

wr  =  10. ; 

wb  =  -180.; 

wt  =  180.  ; 

xstep  =  0 .  ; 

ystep  =  45.  ; 

xtitle  =  "ka"; 

ytitle  =  "PHASK"; 

init  coordsCgfd,  wl ,  wb ,  wr ,  wt ,  .15,  .15,  .18,  .05); 
wc  to_vdc(gfd,  wl ,  wb ,  0.,  &xl,  &y 1 ,  Sdun) ; 
wc_to_vdc (gfd ,  wr ,  wt ,  0.,  &x2,  &y2,  &dum); 
c lip_rec tang le (gfd ,  xl,  x2,  yl,  y2); 
axisCgfd,  wr  -  .00001,  -180.,  xstep,  ystep); 

y_labels_r(gfd ,  wr,  0.,  ystep,  0.,  ystep,  wb,  wt ,  "/.5.0f.",  ytitle); 

/* 

Draw  the  phase  data  curve. 

*/ 

aline  =  iline [0  ]  ; 

for  (1  =  0  ;  i  <=  n  ;  i++) 

{ 

*al ine++; 

*aline  +  t  =  180.  *  phas''[i]  /  pi; 

} 

line_color_index(gfd ,  3); 
polyline2d(gfd ,  line,  n,  FADSF); 
line  color  indexCgfd,  5); 

/* 

Read  the  next  line  of  input. 

*  / 

/ 

fscanf(fp,  n’l  [  A-Za-zO-9 , .  +- =]'n",  title); 
strcpy(title,  buffer); 

} 

n  =  0 ; 

} 

/* 

Store  the  data  from  the  current  line  into  the  appropriate  arrays. 

*/ 

else 

sscanfCbuf fer,  '7.*d  %lg  %lg  %lg  "‘Ig",  &ka[n],  &amp[n],  &phase[nl); 
n-t  t ; 

} 


} 
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/* 

Get  a  new  graphics  surface  and  dra.w  labels  and  .ixes  f;jr  the  last  plijt. 

*/ 

c  1  ear_view_sur f  ace (gf  d ) ; 

wl  =  0.  ; 

wr  =  10.  ; 

wb  =  0. ; 

wt  =  2.2001; 

xs  tep  =  1 .  ; 

y  s  t  e  p  =  .  2  ; 

xtitle  =  "ka": 

yti t le  =  "4MP1 1 Tung" ; 

i ni t_coords (gf  ,  wl ,  wb,  wr,  wt ,  .15,  .15,  .18,  .05); 
wc_to_vdc  (gf  d ,  wl  ,  wb ,  0.,  '■xl,  &yl,  Sdura); 
wc_to_vdc(gfd ,  wr,  wt ,  0.,  J.x2,  &y2,  &diim); 
c 1 ip_rec tangle (gfd  ,  xl,  x2,  yl,  y2); 
axis(gfd,  0.,  0.,  xstep,  ystep); 

x_l abels (gf d ,  0.,  0.,  xstep,  0.,  xstep,  w’  ,  wr ,  "%2.0f.",  xtitle,  title2); 
y_labels(gfd ,  0.,  0.,  ystep,  0.,  ystep,  wb,  wt ,  "%3.1f",  ytitle); 
text_allgnRent(gfd ,  Ta\f.FT,  TA_BbTrOM,  0.,  0.); 
character_size (gf d ,  .05,  .5); 
sscanf (&t i t le [40] ,  "%f",  &xl); 

sprintf (buf fer2,  "PHI  =  S2.0f.  DEG.",  xl  *  180.  /  pi); 

inqui  re_text_extent  (gf  d  ,  "A",  W0RLD_C00RD1N’ATE_TEXT  ,  extent); 

xl  =  extent[9]  -  extent[3]; 

yl  =  extent[10]  -  extent[4]; 

x2  =  0.  +  2.  *  xl; 

y2  =  .45; 

text2d(gfd,  x2,  y2,  buffer2,  WORLD_COORDIN’ATE_TEXT,  FALSE); 
y2  -=  yl; 

oharacter_si2e(gf d ,  .06,  .5); 

text2d(gfd,  x2,  y2,  "a",  w:iRLD_COORDlNATE_TEXT,  FALSE); 
character_size(gfd ,  .05,  .5); 
x2  +=  xl; 

tcxt2d(gfd,  x2,  y2,  "  =  1  METER",  WORLD_COORDINATE_TEXT,  FALSE); 

x2  -=  xl ; 
y2  -=  yl; 

text2d(gfd,  x2,  y2,  "V",  WORLD_COORDINATE_TEXT,  FAI.SE); 
x2  +=  xl ; 

text_alignnent (gfd ,  TA_LEFT,  rA_HALF,  0.,  0.); 

text  2d (gfd,  x2,  yl,  "s",  WORLD_COORDI NATE  TEXT,  FAI.SE); 

x2  +=  xl ; 

text_alignniont(gfd,  TA_LEFT,  TA_BOTrOM,  0.,  0.); 

texf2d(gfd,  x2,  yl,  "  =  2,500  m/s",  WORLD_COORni NATE_TEXT ,  FALSE); 

yl  >-=  yl; 
x2  =  8. ; 

text_a]  ignnent  (gf  d ,  TA_RIGHT,  TA  BOTl'OM.  0.,  0.); 
t.'xt2d(gfd,  x2,  yl,  "AMP.  ",  WOR'i,D_COORDINATE_TFXT,  FALSE); 

1 1  ne_color_: nde < (gf d ,  2); 

Tiicjve2d(gfd ,  x2,  yl  +  .5  *  yl); 
dr.3w2d(gfd,  9.,  y2  +  .  5  *  yl); 
yl  -=  yl; 

text2d(gfd,  x2,  yl,  "PHASE  ",  WORLDjCOORDINATF.  TEXT,  FALSE); 

1 i ne_color_indox(gf d ,  3); 
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move2d(gfd,  x2 ,  y2  +  .5  *  yl); 
draw2d(gfd,  9. ,  y2  +  .5  *  yl  ); 
llne__color_  indi'x(gfd  ,  5); 

/* 

Draw  the  amplitude  data  curve. 

*/ 

al ine  =  &line [0  ]  ; 

for  (i  =  0  ;  i  <=  n  ;  i  +  ^-) 

{ 

*al  ine+  i-  =  ka  [  i  ]  ; 

*allne++  =  amp  [  i  1  ; 

} 

line_color_inde:<(gfd  ,  2); 
polyline2d(gfd,  line,  n,  FALSE ) ; 

/* 

Draw  the  axes  and  labels  for  the  phase  data. 

*/ 

line  color  index(gfd,  5); 

wl  =  0. ; 

wr  =  10.  ; 

wb  =  -180.; 

wt  =  180.  ; 

xstep  =  0.  ; 

ystep  =  45.  ; 

xtitle  =  "ka"; 

ytitle  =  "PHASE"; 

init_coords (gfd ,  wl,  wb ,  wr ,  wt ,  .15,  .15,  .18,  .05); 
wc__to_vdc(gf d ,  wl ,  wb,  0.,  &xl ,  &yl,  Sduia); 
wc_to_vdc(gfd  ,  wr  ,  wt ,  0.,  ?ix2  ,  &y2,  &duni) ; 
clip_rectangle(gfd ,  xl,  x2,  yl,  y2); 
axis(gfd,  wr  -  .00001,  -180.,  xstep,  ystep); 

y_labels  r(gfd,  wr,  0.,  ystep,  0.,  ystep,  wb,  wt ,  "115. Of.",  ytitle); 

/* 

Draw  the  phase  data  curve. 

*/ 

aline  =  Sline [0  ]  ; 

for  (i  =  0  ;  i  <=  n  ;  1-*-+) 

{ 

*al  ine  +  t-; 

*aline++  =  180,  *  phase [i)  /  pi; 

} 

line_color_index(gfd ,  3); 

Polyl lne2d(gfd ,  line,  n,  FALSE); 

^  line_color_index(gfd ,  5); 

Close  the  input  file  and  the  graphics  device. 

f close ( f p ) ; 
gclose(gfd); 
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/* 

Procedure  :  graph_dispb 

Author  :  J.C.  Biard 

Discussion  : 

This  procedure  draws  plots  of  the  data  fron  the  program  dispb. 

Invocation  : 

The  procedure  is  run  by  typing 

g;aph_dispb  ifile  gdev  gdriver 

wV.ere  ifile  is  the  data  file  output  by  dispb,  gdev  is  the 
name  of  the  graphics  device  special  file,  and  gdriver 
is  the  driver  name  for  the  graphics  device. 

External  V.-riables  :  none 

Procedures  called  from  this  module  : 

axis  Draws  axes  and  tic  marks  for  the  plot. 

character_size  Sets  the  size  of  the  characters. 
init_coords  Initializes  the  plotting  surface. 

x_labels  Draws  x  axis  labels  and  titles  the  plot, 

y  labels  Draws  y  axis  labels  to  the  left  of  the  axis. 

y_labels_r  Draws  y  axis  labels  to  the  right  of  the  axis. 

*/ 

//include  <stdio.h> 

//include  <s  t arbaso .  c  . h> 

main(argc,  argv) 
int  argc; 
char  *argv [  ]  ; 

{ 

char  *xtitle,  *ytitle,  title[a32],  buffer[132],  buf f er2 [ 1 32 ] ; 

int  i,  n,  gfd,  virgin,  ncurve; 

float  xl,  x2,  yl,  y2,  dum; 

float  wl ,  wr ,  wb,  wt ,  xstep,  ystep; 

float  line[5001,  *aline; 

double  ra[250],  amp(230],  phase(250]; 

FILE  *fp; 

char  *strcpy(),  *strcat(); 

FILE  *fopen(); 

virgin  =  0; 

/* 

Open  the  graphics  device  and  the  input  file. 

*/ 

gfd  =  gopen (argv [ 2 ] ,  OUTDEV,  argv[3],  RESET_DEVICE | INIT ) ; 
fp  =  f open(argv [ 1 1 ,  "r"); 
n  c  u  r  V  e  =  0 ; 
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Re.-ivl  a  1 '■  ae  fron  tht?  input  file  until  the  e;id  of  the  file. 

*/ 

while  (Es -anfC:  a,  "%  [  A  Za -zO-9  ,  .  +— ]'n",  buffer)  >  0) 

{ 

/* 


If  3  title  line  is  read  tr'.en  either  get  the  title  ol  plot  data. 

*/ 

if  (buffer[0]  ==  'D’l 

{ 

/* 


/* 


/* 


/* 


If  this  is  the  first  title  line,  get  the  title. 

if  (virgin  ==  0) 

{ 

fscanf(fp,  [  A-Za-zO-9  , .  +-=l'n",  bufferZ); 

sscanf ( buf f e r  ,  "%[',]  %*26c%26c"  ,  title,  buffer?'; 
3 pr in t f ( t i t le ,  "Xs,  %26c",  title,  buffer?); 
virgin  =  1; 


If  this  is  not  the  first  title  line,  plot  the  data. 

else 

{ 

n  c  u  r  V  0  +  t ; 

Start  a  new  plot  for  every  third  curve. 

if  (ncurve  X  2  ==  I ) 

{ 

Get  a  new  page  a.  d  draw  labels  and  axes. 

c 1 e  a  r_v i - w_s  u  r  f  a  c  e ( g  f  d ) ; 

1  ino_typc  (gfd  ,  SO!. ID); 

wl  =  0. ; 

wr  =  50.  ; 

wb  =  0.  ; 

wt  =  2.2; 

xstep  =  5.  ; 

ystep  =  . 2 ; 

xtitle  =  "r/a"; 

y  itle  =  "Amplitude"; 

init_coords(gfd ,  wl ,  wb,  wr ,  wt ,  .15,  .15,  .05,  .05); 
wc_to__vdc  (gfd  ,  wl ,  wb  ,  0.,  &xl  ,  &y  I ,  &dum); 
wc_to_vd.;  (gfd  ,  wr ,  wt ,  0.,  &x2,  &y2,  &duni): 
cl ip_recrangle(gfd,  xl,  x2,  yl,  y2); 


a  :<  1  s  (  g  f  d  ,  0 .  , 
X  lab^'ls(gfil  , 

o  o 

xstep,  ystep); 
0.  ,  xst^‘p  ,  0.  , 

xstep , 

wl  ,  wr  , 

";.2.0f ." 

,  xtitle 

title); 
y  lab-'lsCgfd  , 

0., 

0.,  ystep,  0. , 

ystep. 

wb,  wt , 

".13.  If", 

y  t  i  1 1  e  ) 

} 


/'* 

Select  the  line  Htylc  a[>pro;)riate  for  each  curve  nu::.ber  in  the  plot. 

*/ 

switch  (ncurve  %  3) 

{ 

case  0: 

line_type(gfd,  DASH_D0T_D0T ) ; 
break ; 
case  1: 

llne_typi-‘ (gfd ,  SOLID); 
break ; 
case  2; 

li ne_type (gfd ,  DASH_D0T); 
break ; 

} 

/* 

Draw  the  curve. 

*/ 

aline  =  &line [0] ; 

for  (i  =0  ;  1  <=  n  ;  i++) 

{ 

*aline++  =  ra[i]; 

*aline++  =  arnp[i]; 

} 

poIyHne2d(gfd ,  line,  n,  FALSE); 

/* 

Read  the  next  line. 

*/ 

fscanf(fp,  n% [A-Za-zO-9, .  +-=]'n",  bufferZ); 

/* 

If  the  next  set  of  data  will  start  a  new  plot,  get  the  title. 

*/ 

if  (ncurve  %  3  ==  0) 

{ 

sscanf  (buf  fer  ,  "%[',]  %*26c”;26c"  ,  title,  buffer2); 
s  p  r  in  t  f  ( t  i  t  le  ,  "%s,  '^26c",  title,  buffer2); 

) 

} 

n  =  0 ; 

} 

/* 

Store  the  input  data  in  the  apj'ipriate  locations. 

*/ 

else 

{ 

sscanf  (buf  fer ,  "%*d  %lg  l.*lg  %]g  %*lg",  tra[n],  fianp[n]); 

n+  *• ; 

} 

} 
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/* 

Draw  the  last  line  in  the  file. 

*/ 

line_type(gfd  ,  DASH_DOT__DOT  ) ; 
aline  =  Sline [0] ; 
for(i=0;l<=n;  i+t) 

{ 

*al  ine^  =  ra  [  i  ] ; 

*al inet+  =  amp [ i ] ; 

} 

polyl ine2d(gf d ,  line,  n,  FALSE); 

/* 

Close  the  graphics  device  and  the  input  file. 

*/ 

fclose(fp) ; 
gclose(gfd); 


H . 3 . 1 . A  graph-di sped 


/* 

Procedure 


:  graph_dispcd 


Au  t  ho  r 


;  J.C.  Biard 


Discussion  : 

This  procedure  draws  plots  of  the  data  from  the  program  disped. 
Invocation 

The  procedure  is  run  by  typing 

graph_dispcd  ifile  gdev  gdriver 

where  ifile  is  the  data  file  output  by  disped,  gdov  is  the 
n.'.ne  of  the  graphics  device  special  file,  and  gdriver 
is  the  driver  name  for  the  graphics  device. 

External  Variables  :  none 


Procedures  called 
axis 

character_size 
ini  t_coords 
x_labels 
y_labels 
y_labels  r 


from  this  module  : 

Draws  axes  and  tic  marks  for  the  plot. 

Sets  the  size  of  the  characters. 

Initializes  the  plotting  surface. 

Draws  x  axis  labels  and  titles  the  plot. 

Draws  y  axis  labels  to  the  left  of  the  axis. 
Draws  y  axis  labels  to  the  right  of  the  axis. 
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"incl'.uie  <stdio.h> 
•/include  <s  t  a  rb  use  .  c  .h> 


raain(argc,  argv) 
int  argc; 
char  *argv [ ] ; 

{ 

char  *xtitle,  *ytitle,  title[132],  buffer[132l,  buf f er2 [ 1 32 ) ,  *ticle 

int  i,  n,  gfd,  virgin,  ncurve; 

float  xl ,  x2,  yl,  y2,  dun,  extent[12]; 

float  wl ,  wr ,  wb,  wt ,  xstep,  ystep,  r,  psi,  pi; 

float  line[500],  *aline; 

double  phi[250],  amp[250],  phase[250); 

FILE  *fp; 

char  *strcpy(),  *strcat(); 
double  sin(),  cos(); 

FILE  *fopon (  )  ; 

pi  =  3. 141592654; 
virgin  =  0; 

/* 

Open  the  graphics  device. 

*/ 

gfd  =  gopen(argv [ 2  ]  ,  OUTDEV,  argv[3l,  RESET_DEVICE | INIT ) ; 

/* 

Set  the  pens  to  use  for  lines  and  text. 

*/ 

text_color_i  ndex(gfd ,  5); 
line_color_index(gfd ,  5); 

/* 

Open  the  input  file. 

*/ 

fp  =  fopen(argv  [  1  ] ,  "r"); 
ncurve  =  0; 

/* 

Read  an  input  file  line  until  the  end  of  the  file. 

*/ 

■^hlle  (fscanf(fp,  "%  ( A-Za-20-9 , .  +-='f]'n",  buffer)  >  0) 

{ 

/* 

If  a  title  line  is  seen  get  the  title  or  plot  the  accuraulated  du-a. 

*  / 

if  (bufferlO]  ==  ''f  |i  baifer[0]  ==  'D') 

{ 

/* 

If  this  is  the  tirst  title  line,  then  get  the  title. 

*/ 

if  (virgin  ==  0) 

{ 

fscanf(fp,  nZ  [  A-Za-zO  9, .  t--'f]'n",  bufferZ); 
strcpy (title,  buffer); 
virktin  =  1; 

} 
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/* 

If  this  is  not  the  first  title  lino,  then  plot  the  d.-itn. 

*/ 

else 

{ 

/* 

Plot  three  sets  of  dat.s  on  a  page. 

*/ 

ncurve++; 

if  (ncurve  %  3  ==  1 ) 

{ 

/* 

If  this  is  to  start  a  new  plot,  then  get  a  new  surface  and  draw  axes 
and  labels. 

*  / 

clear_view_surface (gfd ) ; 

wl  =  -2 . ; 

wr  =  2 . ; 

wb  =  0. ; 

wt  =  2.  ; 

xstep  =  .5; 

ystep  =  0. ; 

xtitle  =  "AMPLITb'DE  (REL.)"; 
ytltle  =  " 

title2  =  "TOTAL  SH-WAVE  POLAR  AMPLITUDE  SCATTERING"; 
init_coords(gfd,  wl ,  wb ,  wr ,  wt ,  .15,  .15,  .15,  .05); 
wc__to_vdc(gfd ,  wl,  wb,  0.,  &xl,  &yl,  &duo); 
wc__to_vdc(gfd ,  wr,  wt ,  0.,  &x2,  &y2,  &dun); 
clip_rectangle(gfd ,  xl ,  x2 ,  yl,  y2); 
axisCgfd,  -3.,  0.,  xstep,  ystep); 

x_labels (gfd ,  0.,  0.,  xstep,  0.,  xstep,  wl ,  wr ,  "%3.1f", 
xtitle,  t i t le2) ; 

c 1 lp_ind  tcator (gf d ,  CLl P_T0_VUC) ; 

/* 

Draw  curved  dotted  line  of  radius  .2. 

*/ 

line_color_index(gfd  ,  6); 
r  =  .2; 

move2d(gfd  ,  r ,  0. ) ; 

for  (psi  =  0.  ;  psi  <=  2.  *  pi  +  .001  ;  psi  +=  pL  /  90.) 

{ 

xl  =  r  *  cos(psi); 
yl  =  r  *  sin(psi); 
draw2d(gfd,  xl,  yl); 

} 

/* 

Draw  curved  dotted  lines  of  radius  1.  and  2. 

*/ 

for  (r  =  1.  ;  r  <=  2.  ;  r+t) 

{ 

move2d(gfd,  r,  0.); 

for  (psi  =  0.  ;  psi  <=  pi  +  .001  ;  psi  +=  pi  /  300.) 
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axis(i'fd,  0.,  0.,  xstep,  ystep); 
1  ine_color_l iidex (gf d  ,  6); 


1 
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{ 

xl  =  r  *  cos(psi ) ; 
yl  =  r  *  sin(psi); 
draw2d(gfd,  xl ,  yl); 

} 

} 

/* 

Draw  radial  lines  and  angle  labels  at  every  15  degrees  around  the 
radius  2.  circle. 

*/ 

r  =  2.  ; 

charac ter_size (gf d  ,  .035,  .5); 

inquire_text_extenc(gfd,  "A",  WORLD_COORDlN'ArE_TEXT ,  vx;  nc); 
x2  =  extent[9]  -  extent[3); 

for  (psl  =  0.  ;  psi  <-  pi  +  .0001  ;  psi  +=  pi  /  6. ) 

{ 

xl  =  r  *  . os(psi ) ; 
yl  =  r  *  sin(psi); 
move2d(gfd,  0.,  0.); 
draw2d(gfd,  xl,  yl); 

sprintf(biiffer2,  "%1.0f",  psi  *  180.  /  pi); 
if  (psi  <  pi  /  2.  -  .1) 

{ 

text_allgnraent(gfd,  TAJ.EFT,  TA_B0TT0M,  0.,  0.); 
xl  +=  .5  *  x2; 

cext2d(gfd,  xl,  yl,  buffer2,  V0RLD_C00RD1NATE_TEXT ,  FAISE); 

) 

else  if  (psi  -  pi  /  2.  <  .01) 

{ 

text_allgnment(gfd,  TA_CENTER,  TA_B0TT0M,  0.,  0.); 
text2d(gfd,  xl,  yl,  buffer2,  v;0RLD_C00RDINATE_TEXT ,  EA'.SE); 

} 

else 

{ 

text_allgnnent(gfd,  TA_R1GHT,  TA_B0TT0M,  0.,  0.); 
xl  -=  .5  *  x2; 

text2d(gfd,  xl,  vl,  buffer2,  WORLD_COORDINATE_TEXT,  FAlSE); 

} 

} 

/* 

Draw  graph  legends. 

*/ 

1 i ne_color_index(gfd ,  5); 

text_align:nent(gfd,  TA_hEFT,  TA_Bi  iTOM,  0.,  0.); 
cha rac ter_si 7.0  (gf d ,  .05,  .5); 
sscanf  ( &  t  i  1 1  e  [  A  7  ] ,  ''%f",  &xl); 
s  pr  i  lit  f  ( buf  f  0  r2  ,  "  =  Xl.Of.",  xl); 

inquire  text  extent(gfd,  "A",  WORLD_COuRDlNATE_TEXT,  extent); 
xl  =  extent[9l  -  extentjl]; 
yl  =  extent[10]  -  extentiA]; 
x2  =  wl; 

[  y2=wt+4.*yl; 

cha rac ter_s i ze (gf d ,  .06,  .5); 

text2d(gfd,  x2,  y2,  "r/a",  WORLD_COORDlNATE_TKXT,  FALSE); 
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cha  rac  tt' r__s  i  ze  (gf  d  ,  .Oa,  .5); 
x2  +=  3.  *  xl; 

text2d(;fd,  x2  ,  y2,  buffer2,  I 'iATS^T;-' X  I' ,  F'XS-'); 

x2  -=  3'.  *  xl; 
y2  -=  ,1; 

charac C e r_s i Ze (gf d ,  .Ob,  .5); 

text2d(gfJ,  x2,  y2,  "a”,  WORI.n__COO-Kr)I\-Alt_TEXl' ,  FA'dK.); 
cha rac te r_si ze (gfd ,  .05,  .5); 
x2  +=  xl ; 

text2a(gfd,  x2 ,  y2,  "  =  1  METER",  W0Rl,n_C00RniNA3K_TEXr ,  FAI.'^F); 

x2  -=  xl : 
y2  -=  yl; 

text2d(gfd,  x2,  y2,  "V",  WOR[.D_  COORDlSArE_TEXT,  FALSE); 
x2  +=  xl; 

textual  Ignnefit.  (gfd  ,  TA__LFFT,  TA_HALF,  0.,  0.); 
t:exc2d(gfd,  x2,  y2,  "s",  WORLD_COOROI  NATE_TKXT ,  FALSE); 
x2  +=  xl; 

text_al  igncieiK  (gf  d ,  TA_LFFr,  TA_B0ir0M,  0.,  0.); 

text2d(gfd,  x2,  y2,  "  =  2,500  ci/s",  WORLn_  COOROf.VArE_Tf:\;  ,  FAi'.S-:) 

y2  =wt  +4.  *yl; 
x2  =  1.5; 

te  xt_al  IgniTioat  (gf  d  ,  TA_R[(7.HT,  TA_BOTTOM,  0.,  0.); 

Cext2d(gfd,  x2,  y2,  "ka  =  .5",  WORLn_COORJlNATE_TEXr ,  FALSE); 

1 ine_color_index(gfd ,  2); 
movo2d(gfd,  x2  +  . 5  *  xl,  y2  +  .5  *  yl); 
draw2d(gfd,  2.,  y2  +  .5  *  yl); 
y 2  -=  yl ; 

text2d(gfd,  x2,  y2,  "ka  =  1.0",  WORLr)_COORDINATK_TF.X  1 ,  FAI.SE); 

line_color_index(gfd ,  3); 

cnove2d(gfd,  x2  +  .5  *  xl,  y2  +  .5  *  yl); 

draw2d(gfd,  2.,  y2  +  .5  *  yl); 

y2  -=  yl; 

Cext.2d(gfd,  x2,  y2,  "ka  =  2.0",  W')RLn_C<JOR!)  [SATE_TEX1  ,  FAISE); 

1  ino__color_  index(gfd  ,  4); 

mo'.  .;2d(gfcl ,  x2  +  .5  *  xJ,  y2  +  .  5  ♦  yl); 

draw2d(gfd,  2.,  y2  +  . 5  *  yl); 

c  1  i  p_i nd  i  c  a  t  o  r  ( g  f  d  ,  CL  1  R_T0_R;:C  f ) ; 

line_color_index(gfd ,  5); 

} 

/* 

Seloc*;  the  proper  pen  color  for  the  current  curve  to  plot. 

*/ 

swl Cch  (ncu rve  X  3 ) 

{ 

case  0: 

llne_color_index(gfd ,  4); 
break ; 
case  1 ; 

llne_color_lndex(gfd ,  2); 
break ; 
ca .e  2 ; 

1  In.  _color_lndex(gfd ,  3); 
break ; 
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Di'ciW  the  curve. 


i  * 

*/ 

aline  =  &  H  I',  e  ( 0  ]  ; 

for  (i  =  0  ;  i  <=  n  ;  i++) 

{ 

*aHno++  =  «mp[il  *  cos  (phi  [  1 1 ) ; 

*aline++  =  ampli]  *  sin(phi(i]); 

} 

polyl ine2d(gfd ,  line,  n,  F^LSE); 

Hne_color__index(gfd ,  5); 

/* 

Read  the  next  input  line. 

*/ 

fscanf(fp,  "'n  lA-Za-zO-9,.  ^  — f]'n",  buffer2): 

/* 

If  the  next  curve  will  start  a  new  graph,  save  the  title  line. 

*/ 

if  (ncurv  %  3  ==  0) 

{ 

St repy ( t i t le  ,  buffer); 

} 

} 

n  =  0 ; 

} 

/* 

Store  the  input  data  in  the  proper  arrays. 

*/ 

else 

s  scan  f  ( bu  f  f  e  r  ,  ".,*d  %lg  %lg  I.*lg",  iphiln],  (.amp[nl); 
n  +  +■ ; 

} 

} 

/* 

Plot  the  last  curve  in  the  file. 

*/ 

1 ine_color_index(gfd  ,  4); 
al ine  =  61ino [0  ]  ; 
for(i=0;  i<=n;  i++) 

{ 

*aline+F  =  arap [ i ]  *  cos(phi'i]); 

*aline++  =  ampli]  *  sinfphi [ i ] ); 

} 

polyl  ine2d(gfd  ,  line,  n,  FAI.SE); 
clear  vie  w_s  u  r  f  a  c  e  ( g  *'  d  ) ; 

/* 

Close  the  input  file  and  the  graphics  device. 

*/ 

f  c  1  oso  ( f  p ) ; 
gclosc(gfd); 
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H.3.1.')  graph_dispi 

/* 

Procedure 
Author  :  J.C.  Biard 

Discussion  : 

This  procedure  dnws  plots  of  the  data  from  the  program  dispe. 

Invocation  : 

The  pr'jcedure  is  run  by  typing 

graph_dispe  ifile  gdev  gdriver 

where  ifile  is  the  data  file  output  by  dispe,  gdev  is  the 
name  of  the  graphics  device  special  file,  and  gdriver 
is  the  driver  name  for  the  graphics  device. 

External  Variables  :  none 

Procedures  called  from  this  module  : 

axis  Draws  axes  and  tic  marks  for  the  plot. 

character_si2e  Sets  the  size  of  the  characters. 
init_coords  Initializes  the  plotting  surface. 

x_labels  Draws  x  axis  labels  and  titles  the  plot. 

y_labels  Draws  y  axis  labels  to  the  left  of  the  axis. 

y_labels_r  Draws  y  axis  labels  to  the  right  of  the  axis. 

*/ 

include  <stdio.h> 

^*include  <s  t  a rbase  . c  .h> 

niaLn(3rgc,  argv) 
int  argc; 
char  *a.  .jv  n  : 

{ 

char  *x'itle,  *ytitle,  title[132],  buffer(132]; 

int  i,  n,  gfd,  virgin; 

float  xl ,  x2,  yl,  y2,  dum; 

float  wl ,  wr ,  wb,  wt ,  xstep,  ystep; 

float  line[500],  *aline; 

double  x(250l,  amp[250l,  phase[230l; 

file  *fp; 

char  *strcpy(); 
file  *fopen(); 

virgin  =  0; 
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Open  the  tit^phics  dev’ce. 

*/ 

gfd  =  gopen(;irgv[2],  OUTDKV,  argv[3l,  KrSK;T_uEVlCE  |  IN  IT )  ; 

/* 

Open  the  input  file  for  reading. 

*/ 

fp  =  fopen(argv [ 1 ] ,  "r"); 

/* 

Read  the  ! ile  until  the  end  and  load  the  appropriate  values. 

*/ 

while  (fscanf(fp,  "%(A-Za  /:0-9, .  +-  =  ]'n”,  buffer)  >  0) 

{ 

/* 

If  a  title  line  is  found,  then  get  the  title  or  plot  the  data. 

*/ 

it  (buffer[0]  ==  'D') 

{ 

/* 

If  this  is  the  first  pass,  get  tie  title. 

*/ 

if  (virgin  ==  0) 

{ 

fscanf(fp,  ’’'n%[A-Za-zO-9, .  +--]'n",  title); 
s t rcpy ( t i t le ,  buffer); 
virgin  =  1; 

} 

/* 

If  this  is  not  the  first  pass,  prepare  to  plot  the  data. 

*/ 

else 

{ 

/* 


Get  a  :ew  screen  and  draw  the  axes  .and  labels. 

*/ 


clea r_view_su r  f3ce(gfd); 
wl  =  -50. ; 
wr  =  50. ; 
w  b  =  0 .  ; 
wt  =  2.2; 

X  s  t  e  p  =  10.; 
ystep  =  .2; 

xtitle  =  "x  (raeteis)"; 
ytitle  =  "Amplitude''; 

init_coords(gfd ,  wl ,  wb,  wr ,  wt ,  .15,  .15,  .05,  .05); 
wc _to_vdc(gfd ,  wl ,  wb,  0.,  Sxl,  &yl,  &dum); 
wr  to_vdc(gfd,  wr,  wt ,  0.,  Sx2,  &y2,  &durn); 
c 1 i p_rect angle (gfd ,  xl,  x2,  yl,  y2); 


a  X  i  s  (  g  f  d  ,  w  1 , 
X  labels (gfd. 

0., 

wl, 

xst( 

0., 

p,  ystep); 

XStep ,  wl , 

xstop , 

wl  ,  wr , 

’’%2.0f ." 

title); 

y_labels(gfd. 

wl  , 

ystep,  0., 

ystep. 

wb,  wt , 

"%3. It", 

,  xtitle, 
ytitle); 
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/* 


*/ 


Draw  the  a-'pl  i  c ade  data  aceunnilated  . 

aline  =  &1 i ne [0  ]  ; 

for  (i  =0  ;  i  <=  n  ;  i++) 

{ 

*aline+i  =  x[ i ] ; 

*aline++  =  amp [ i ] ; 

} 

polyl ine2d(gfd ,  line,  n,  FALSE); 

Get  a  new  screen  an(!  draw  the  axes  and  labels. 
clear_view__surface(gfd) ; 

wl  =  -50 .  ; 
wr  =  50 .  ; 
wb  =  -10.; 
wt  =  10. ; 
xstep  =  10.  ; 
ystep  =  2. ; 

ytitle  =  "phase  (radians)"; 

init  coords(gfd,  wl ,  wb,  wr ,  wt ,  .15,  .15,  .05,  .05), 
wc  to  vdcCgfd,  wl ,  wb ,  0.,  &xt,  &y 1 ,  &dun); 
wc  to  vdcCgfd,  wr ,  wt ,  0.,  &x2,  &y2,  &dun); 
clip_rectangle(gfd ,  xl ,  x2 ,  yl-.OOl,  y2); 
axisCgfd,  wl,  wb,  xstep,  ystep); 

x_labels(gfd,  wl ,  wb,  xstep,  wl ,  xstep,  wl  ,  wr ,  ":;2.0f.",  xtUle, 

title);  1  \ 

y_labels(gfd,  wl,  0.,  ystep,  0.,  ystep,  wb,  wt ,  ,  ytitle); 

Draw  the  phase  data  accumulated. 

aline  -‘  &  1  ine  [0  1 ; 
for  (i  =  0  ;  i  <=  n  ;  itv) 

{ 

*aline++; 

*aline++  =  phase (i); 

} 

polyl  ine2d(gfd ,  line,  n,  FA(,SK); 
fscanfCfp,  "'n,^[A-Za-zO-9,.  +-=i'-n",  title); 
strcpy(title,  buffer); 


t 

¥- 

I 


/* 

*/ 


} 


n  =  0; 


If  there  is  not  a  title,  then  read  the  data, 
else 


{ 


sscanf  (buffer,  ";;*d  %lg  ’llg  "Ig  %*lg",  &x[n],  &anp[nl,  &phase[n!): 

n+t; 


} 


/* 

Get  a  new  screen  and  draw  the  axes  and  labels. 

*/ 

c lear_view_sur f  ace (gf  d  )  ; 

wl  =  -50. ; 

wr  =  50. ; 

wb  =  0. ; 

wt  =  2.2; 

xstep  =  10. ; 

y  s  t  e  p  =  .2; 

ytitle  =  "Amplitude"; 

init_coords (gfd ,  wl ,  wb,  wr ,  wt ,  .15,  .15,  .05,  .05); 
wc_to_vdc(gfd ,  wl ,  wb,  0.,  Sixl,  &yl,  &dum); 
wc_to_vdc(gfd ,  wr,  wt ,  0.,  &x2,  &y2,  &dum); 
clip_rectangle(gfd ,  xl,  x2,  yl,  y2); 
axisCgfd,  wl ,  0.,  xstep,  ystep); 

x_labels(gfd ,  wl ,  0.,  xstep,  wl ,  xstep,  wl ,  wr ,  "%2.0f.",  xtitle,  title); 
y_labels (gfd ,  wl ,  0.,  ystep,  0.,  ystep,  wb ,  wt  ,  "%3.1f",  ytitle); 

/* 

Draw  the  amplitude  data  accumulated. 

*/ 

aline  =  &line [0] ; 

for  (i  =  0  ;  i  <=  n  ;  i-H-) 

{ 

*aline+-t-  =  x[  i  ]  ; 

*aline++  =  amp [ i ] ; 

} 

polyline2d(gfd ,  line,  n,  FALSE); 

/* 

Get  a  new  screen  and  draw  the  axes  and  labels. 

*/ 

clear  view_surface(gfd  ) ; 

wl  =  -50. ; 

wr  =  50. ; 

wb  =  -10.; 

wt  =  10. ; 

xstep  =  10.  ; 

ystep  =  2. ; 

ytitle  =  "phase  (radians)"; 

i n i t_coords (gf d ,  wl ,  wb,  wr ,  wt ,  .  15,  .  1  5,  .05,  .05); 
wc_to_vdc  (gf  d ,  wl ,  wb,  0.,  Srxl,  Syl,  &dum); 
wc_to_vdc(gfd ,  wr ,  wt ,  0.,  &x2,  &y2,  &dum); 
clip_rectangle(gfd ,  xl,  x2,  yl-.OOl,  y2); 

3xis(gfd,  wl,  wb,  xstep,  ystep); 

x_label s(gfd ,  wl ,  wb,  xstep,  wl  ,  xstep,  wl ,  wr ,  "%2.0f.",  xtitle,  title); 
y_label s (gf d ,  wl ,  0.,  ystep,  0.,  ystep,  wb ,  wt ,  "%4.0f.",  ytitle); 

/* 

Draw  the  amplitude  data  accumul ated . 

*/ 

aline  ■-  &line[0]; 

for  (i  =0  ;  i  <=  n  ;  i++) 

{ 

*al ine++; 

*alinel+  =  phase [i]; 

} 
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polyi;  2d(gf>!,  line,  n,  FALSiO; 

i* 

Clode  the  file  and  the  graphics  device. 

*/ 

fclose ( fp  ) ; 
gelose (gfd ) ; 

} 


n .  3.2  Gr a p h ^j3_  J o Li n e  S o u_r^' e  Results 

The  progran  for  graphing  the  line  source  results  is  more  cornpl  ica '  ed 
t'aan.  the  progra  s  for  graphing  the  plane  wav-'’  results  in  that  there  a  e  ni.'re 
paraneters  to  consider  for  one  graph.  The  program  vuseis  thus  has  an  inpi'.t 
pararetcr  file  that  can  be  used,  if  desired.  An  example  of  this  file  is  pre¬ 
sented  in  Section  H.3.2.3  below. 

Toe  program  vuseis  is  also  written  to  read  the  modeling  output  data  in 
bin.'.ry,  rather  than  ascii,  form.  This  was  done  because  the  output  files  from 
synseis  were  quite  large  and  were  compacted  by  conversion  to  binary.  Allowing 
vuseis  to  read  the  binary  files  saved  time  and  effort.  The  program  that  per¬ 
forms  the  conversion  is  called  compact,  and  is  included  in  Section  H.3.2.2 
be  1 ow. 


H, 3 . 2 .  1  vuse i s 


Procedure  name  :  vuseis 
Author  :  J.C.  Biard 

Discussion  : 

This  program  produces  a  synthetic  si.  i  smog  ra  a  plot 
from  the  data  file  created  by  the  program  synseis.  Information 
is  read  in  from  an  input  file  that  specifies  the  plot  limits  and 
the  scale  factor  to  use  when  plotting  the  waveforms. 

The  se  i  sciLig  r.itn  is  a  distance  vs.  tim-'  plot  in  wtiich  a  number 
of  waveforms  are  plotted  on  the  same  page.  These  wavoforuis 
represen.t  the  signal  recieved  at  a  number  of  different  detectors, 
which  from  a  linear  array.  Each  waveform  is  drawn  parallel  to 
Che  time  axis,  with  the  zero  amplitude  level  corresponding  to 
the  distance  of  the  detection  point  from  the  origin.  The 
magnitude  of  tlio  waveforms  on  the  plot  is  arbitrary.  Only 
relative  sizes  of  signals  and  positional  information  are  intended 
Co  be  obtained  from  one  of  these  plots.  By  setting  the  proper 
variables  in  the  input  file,  It  Is  possible  to  cause  the  signals 
above  a  threshold  level  to  be  blacked  in,  thus  aiding  in  Che 
interpretation  of  the  data. 

The  input  file  contains  three  sets  of  information.  The  first 
set  specifies  the  magnification  scale  fa^'tor  for  the  waveforms 
in  the  plot  and  sets  the  threshold  for  Ltie  peak  blacking  if  desired. 
The  second  set  specifies  the  x  di.;i>Mision  limits  in  meters.  The 
third  set  sp-'cifies  the  time  axis  limits  for  the  waveforms.  If 
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no  input  file  is  included,  then  dffault  limits  for  tl'.esc  vnlnes 
ore  used. 

The  conniund  line  arguments  include  a  single  character  argument 
that  specifies  if  only  the  "i"ncidont,  "s"cattered,  or  "b''oth 
incident  and  scattered  waveforms  are  to  be  plotted  in  the  seis¬ 
mogram.  There  is  also  an  optional  argument  specifying  an  alternate 
graphics  device  for  the  plot. 


Invocation  :  The  program  is  ir.voked  by  the  command 

vuseis  [bis]  [infile]  [gdevice]  [gdriver]  <  da.tafile 
where  the  irgunents  are:  (bracketed  items  optional) 


b 

i 

s 

inf  1  le 
gdevice 
gdriver 
dataf i le 


Plot  both  incident  and  scattered  waveforms. 

Plot  only  i  icident  waveforms. 

Plot  only  scattered  waveforms. 

Input  data  file  for  vuseis. 

Device  special  file  for  the  graphics  device. 

Name  of  the  starbase  graphics  driver  for  gdevice. 
Output  file  from  synsels. 


The  input  data  file  has  the  form: 


100.,  0.  //  Scale,  blacking  threshold  (<0  ■  lef  t ,  >0-right ,  =0-;io;'ie  ) 

0.  ,  0.  //  left  X  limit,  right  x  limit. 

0. ,  120.  #  starting  time  limit,  stopping  time  limit. 

With  no  argiiLients  but  the  indirection  of  the  synseis  datafile, 
the  program  will  plot  all  the  waveforms  in  the  file,  both  incident 
and  scattered,  from  the  leftmost  x  limit  to  the  rightmost,  from 
zero  time  to  the  maximum  time  found,  with  a  unity  scale  factor  and 
no  peak  blacking.  The  graphics  output  will,  by  defau’t,  go  to 
the  terminal  from  which  the  program  was  invoked,  which  is  assumed 
to  be  compatible  with  an  HP  26xx  class  graphics  terminal. 


Procedures  c. tiled  from  this  module  : 


a  X  i  s 

i n i t_coords 
x_labels 
y  labels 


Draws  a  pair  of  x-  and  y-axes  with  optional  tick  marks. 
Sets  up  the  graphics  window  and  character  sizes. 

Draws  the  labels  on  the  x-axis  and  the  plot  head. 

Draws  the  labels  on  the  y-axis. 


Starbase  graph, ies  procedures  called  f;om  this  module  : 

(These  program  codes  are  not  the  property  of  SWRI  and  cannot  be 
published  in  this  report.) 


clear  vie  w_s  u  r  f  a  c  e 
c  1 1  p_rec  t  .ing  le 
gc 1 ose 
go  pen 

i  n  t  e  r  i  o  r_  s  t  y  1  e 
1 ) ne_col or  _1 ndex 
partial  j)ol ygon2d 


Clears  the  croon  or  ejects  the  page. 

Sets  the  software  clip  range. 

Empties  buffers  and  elcses  the  ;;iaphics  device. 
Opens  and  initializes  the  graphics  device. 
Specifies  the  fill  attributes  for  polygons. 
Specifies  which  pen  to  use  in  plotting. 

Builds  a  set  of  incomplete  polygon  edges. 
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p.  lygoi'.:’d 


Draws  a  closaj  polygon  or  -i  sorios  of  inooiT^ploLf- 
polygons . 

polyltnodd  Draws  a  lino  thruagh  a  nu!..b'-r  of  points. 

t ext_ CO lo ig  i ndo\  Specifies  the  pen  to  use  when  drawing  text, 

vdc  Converts  a  position  fron  the  world  coord  inat-;-’ 

syste:?.  to  the  virtual  device  coord  in  ife 
syste  .1. 

Formal  At  .■'-ents  ; 

Input  : 

argc  The  aatibor  of  cotri-nid  line  arguirtents  +  1. 

arg'.  Th-“  array  of  comntand  line  argunents. 

argv[0]  The  narae  of  the  procedure  being  executed. 
argv[l]  (Op*-.)  Indicates  the  type  of  waveform  to  plot. 
argv[2]  (Opt.)  The  input  data  filena-no. 
argv[31  (Opt.)  The  graphics  device  special  filena-no. 

(Opt.)  The  graphics  driver. 

Output  : 
none 

F-xtevnal  variables  : 

notte 

*  ' 


■1* i tv  1  u.D/  <stdio.h> 
Cmath.hb 

•'/iiK' 1  Mflo  <starba  b  t.’’  *  c  •  h> 

3iai:i(  irgc,  argv) 
int.  argc; 


chir  *xtitle,  *ytitle,  *titi-'2,  *point; 

i:'-t  i,  n,  gfd,  j,  k,  xflag,  tflag,  wflag,  lnt’>uf(3I; 

ip. t  nx,  np,  nrofl; 

fioi‘  xl,  x3,  yl,  y2,  dun,  pi,  extent (  1 2 ] ; 
flc  ■  -wl  ,  wr ,  wb ,  -wt  ,  xstep,  ystep; 

fit'  '  sr.ile,  thfesh,  xscale,  xlolim,  xhilin,  tlolim,  thilim; 

fl'/i:  1  i  ne  [  1  6 3  3 1  ,  *aline; 

do".'-.’e  h,  cl,  rhvtl,  c2,  rho2,  wO ,  alpha,  df,  dt ,  a,  xc ,  yc ,  xs ,  ys ,  xO ,  yO; 
doable  ql,  wl,  q2,  w2,  dx; 

double  t.i  i  ,  tds,  xd ,  incI-iO'lb],  scat[A096],  *ap; 

F'ILK  *fpi; 

char  *gets(); 

double  sqrt(); 

Fil.K  *fop.n(); 

pi  --  3 .  1  1 1  3 ') J ')  1  'i ; 

/* 

Set  th''  plot  tin.;  pa  r  i;;i' ■  r  r  s  aecorditig,  to  the  input  a  rgurttui  t  s  . 


swi tch (argc ) 

{ 


/* 

If  no  graph  option,  input  parameter  fi'e  or  driver  information  is 
given  at  run  lime,  set  to  plot  all  and  open  the  terminal  as  the 
graphics  device. 

*/ 

case  1: 

wflag  =  2; 

scale  =  1 . ; 

thresh  =  0. ; 

xlolim  =  xhilim  =  0.; 

t lol im  =  thi 1 im  =  0. ; 

gfd  =  gopen("/dev/tty",  OUTDEV,  "hpterm",  INITI; 
break ; 
case  2: 

/* 

If  only  the  graph  option  is  given  at  run  time,  select  the  graph  to 

plot,  give  the  maximum  ranges,  and  open  the  terminal  as  the  gi.ophics 
device . 

*/ 

swi tch(argv [ 1 ] [0 ]  ) 

{ 

case  'i'; 

wflag  =  0; 
break ; 
case  's': 

wflag  =  1; 
break; 
c  ise  '  b ' : 

wflag  =  2; 
break; 
default ; 

exit(-l ) ; 

} 

scale  =  1 .  ; 
thresh  =  0.  ; 
xlolim  =  xhi 1 im  =  0. ; 
tiolira  =  thilira  =  0.; 

gfd  =  gr  pen("/dev/lty",  Ol’TDEV,  "hpterra”,  INIT); 
break ; 
case  3: 

/* 

If  the  graph  optiiin  and  input  paraiT.eter  files  are  given,  set 
the  appropriate  values  and  flags  and  open  the  terminal  as  the 
graphics  device. 

*/ 

swi tch (a  rgv [ 1 1 [0  ]  ) 

{ 

case  '  i  '  : 

w'lag  =  0; 
break  ; 
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wflag  =  1; 
break ; 
case  ' b '  ; 

wflag  =  2; 
b  r  t-*  tik,  I 
de fault: 

exit(-l); 

} 

/* 

Read  Che  plotting  parameters  from  Che  parameter  file. 

★ 

fpi  =  fopen(argv [2 ] ,  "r"); 
f  scanf  (  f  p  i ,  "%f  ,  Zt  Z*  [  ■"'  n  ]  %f  ,  ZfZ*  [  n]  %f ,  %f  " , 

&icale,  Schresh,  &xlolim,  &xhtlira,  &tlolim,  Sthilim); 
f  close (fpi); 

gfd  =  gopen("/dev/tty",  OUTDEV,  "hpcerm",  INIT); 
break ; 
case  5: 

'* 

If  the  graphic?  option,  parameter  file,  and  graphics  device  informatiiin 
is  all  supplied  at  run  time,  sec  the  appropriate  flags  and  values  and 
open  the  specified  graphics  device. 

k  ^ ' 

switchCargv [ 1 1 [0] ) 

{ 

case  '  i  ' : 
wflag  =  0; 
break ; 
case  's'; 

wflag  =  1; 
break ; 
case  '  b ' : 

wflag  =  2; 
break ; 
de  fault: 

exi t (-1 ) ; 


Read  th.e  plotting  parameters  from  the  parane'.er  file. 

*  ■' 

fpi  =  fopon(argv [2 1 ,  "r"); 
fscanf(fpi  ,"%f  ,%f -if  ,%f’4f  ,%f", 

&scale,  Sthresh,  &xlolira,  Axhilim,  Stlolim,  &thilim); 
f  c  1  o  s  e  (  f  p  i  )  ; 

/* 

Open  the  graphics  device. 

*/ 

gfd  =  gopen(argvni  ,  OUTDEV,  argv[41,  INlT); 
break ; 
default : 

e  :<  i  c  (  - 1  )  ; 

} 
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If  the  default  liinits  are  ta’^en  set  xflag  FALSE,  else  TRLE, 

*/ 

if  (xlolira  !=  0.  ||  xhilim  !=  0.) 
xflag  =  TRUE; 

} 

else 

{ 

xflag  =  FALSE; 

} 

/* 

If  the  default  values  are  not  taken  set  tflag  TRUE,  else  FALSE. 

*/ 

if  (tlolira  !=  0.  ||  thilim  !=  0.) 
tflag  =  TRUE; 

} 

else 

{ 

tflag  =  FALSE; 

) 

/* 

Read  in  the  first  12  bytes  of  the  input  file. 

Store  the  values  obtained  in  the  appropriate  variables. 

*/ 

point  =  (char  *)intbuf; 
fread(point,  sizeof(nx),  3,  stdin); 
nx  =  intbuf [0 ] ; 
np  =  intbuf [ 1 ] ; 
nrefl  =  intbuf[2]; 

/* 

Read  in  the  next  168  bytes  of  the  input  file. 

^  Score  the  values  obtained  in  the  appropriate  variables. 

point  =  (char  *)inc; 

fread(point,  sizeof(h),  21,  stdin); 

h  =  inc [0] ; 

cl  =  inc ( 1  ] ; 

rhol  =  inc[2]; 

c2  =  inc[3]; 

I ho2  =  inc  [  A  ] ; 
wO  =  inc [5]; 
alpha  =  inc  [6  ]  ; 
df  =  inc  (  7  ]  ; 
dt  =  inc [ 8  ]  ; 
a  =  inc [9  ] ; 
xc  =  inc [ 10]  ; 
yc  =  inc  [  1 1  ] ; 
xs  =  inc  1 1 2  ]  ; 
y  s  =  i  n  c  ( 1  3  ] ; 
xO  =  inc [ 14]  ; 
yO  =  inc [ 1 5] ; 
q  1  =  i  n  c  [  1 6  ] ; 
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w 1  =  inc  [  1  /  1  : 
q2  =  inc [ 18  I  ; 
w  2  -  ^  i  n  c  [  1  9  ]  ; 
dx  =  inc [201; 

/* 

Clear  the  view  surface  and  set  the  default  pens. 

*/ 

c  1  e  a  r_v  i  t  *'_s  urface(gfd); 
text__color_index(gf  d  ,  5); 

1  ino_color__index(gfd  ,  1); 

!  ^ 

Set  the  windc.w  lirr.'ts  in  the  x  (horizontal)  and  t  (vortical)  dimensions. 

X 

if  (xflag  ==  TRLd) 

{ 

i  =  (int)(xlolim  /  dx); 
j  =  (int )  (xhi  1  ini  /  dx); 
wl  =  (float  )i  *  dx; 
wr  =  (float)j  *  dx; 

xscale  =  (wr  -  wl )  /  (2.  *  (float )(j  -  i)); 

} 

else 

{ 

wl  =  xO; 

wr  =  xO  +  (f loat ) (nx-1 )  *  dx; 

xscale  =  (wr  -  wl)  /  (2.  *  (float)(nx  -  1)); 

) 

wl  -=  xscale; 
wr  +=  xscale; 
if  (tflag  ==  TRL'K) 

{ 

wb  =  -thilim; 
wt  =  -tlolim; 

} 

els-.' 

wb  -  “191)1).  *  (sqrt(4,  *  yc*yc  +  (wr-wl )  *(wr  “wl ) )  /  c2  +  (double)ni  *  dt) 

wt  =  0.  ; 


Sot  ta-'  tic  mark  step  size  in  x  and  t. 

if  ((xstep  =  ( f loat )(( int )( (wr  -  wl)  /  10.)))  ==  0. ) 

{ 

xstep  =  (f loat )(( int )( (wr  -  wl )  *  10.))  /  100.; 

} 

if  ((ystep  =  (f  loat  )(( int  )( (wt  -  wb)  /  10.)))  =---  0.  ) 
{ 

ystep  =  (f loat )(( int )( (wt  -  wb)  *  10.))  /  100.; 


/* 

Set  the  titles,  initialize  the  World  Coordinate  System  window, 
and  draw  the  ax-'S  and  labels. 

*/ 
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xtitle  =  ''DISTANCE  (m)"; 
ytitle  =  "TIME  (rnSec)"; 

title2  =  "SH-l.’AVE  SYNTHETIC  SEISMOCR.AM" ; 

1 ni t_cooids (gf d ,  wl ,  wb,  wr ,  wt ,  .15,  .15,  .18,  .05); 

wc_to_vdc (gfd ,  wl ,  wb,  0.,  &xl,  &yl,  &dura); 

wc_to_vdc (gf d  ,  wr  ,  wt ,  0.,  &x2,  6iy2,  &dum); 

cl ip_rectangle (gf d ,  xl,  x2,  yl,  y2); 

axis(gfd,  (xO  -  xstep),  wt ,  xstep,  0.); 

axls(gfd,  wl ,  wt ,  0.,  ystep); 

axis(gfd,  (xO  -  xstep),  wb+. 00001,  xstep,  0.); 

xl  =  (wr  +  wl )  /  2. ; 

x_labels (gf d ,  xl,  wb,  xstep,  xl ,  xstep,  wl ,  wr ,  "%0.0f.",  xtitle,  rit’e2); 
y_labels(gfd ,  wl ,  wt ,  ystep,  ”Wt ,  -ystep,  wb,  wt ,  "%0.0f.",  ytitle); 

Loop  over  the  number  of  traces  to  plot  contained  in  the  input  file, 

for  (1  =0  ;  1  <nx  ;  itt) 


Read  the  next  24  bytes  fiom  the  input  and  store  them  in  the  appropriate 
variables. 

point  =  (char  *)&inc[0]; 
fread(point,  1,  24,  stdin); 
xd  =  inc [0  1 ; 
tdi  =  inc [ 1 1 ; 
tds  =  inc [ 2 ; ; 

Read  the  next  8*np  bytes  to  get  the  direct  ..ave  signal  values, 
point  =  (char  *)inc; 

fread(point,  s i zeof (double ) ,  np,  stdin); 

Read  the  next  8*np  bytes  to  ■  et  the  scattered  .■ave  signal  values, 
point  =  (char  *)scat; 

fread(point,  si zeof (double) ,  np,  stdin); 

If  the  trace  is  within  the  pi  't  window  in  x,  then  plot  it. 
if  (xflag  -=  .'^ALSE  [j  (xd  >=  xlolim  &&  xd  <=  xhilin)) 


Load  the  plot  ve.  tor  array  with  the  base  offset  x  value  and  the 
t  value  for  ■  ich  point. 

aline  =  & ‘ ino [ 0 ]  ; 

for  (n  =  0  ;  n  <  16384  ;  n  +-  2) 


*a 1 i ne  -  xd  ; 

*aliiie++  =  -(float)(n  /  2)  *  dt  *  1000.; 


If  the  direct  wave  signal  is  to  be  calculated ,  add  the  signal  value-,, 
with  the  appropriate  offset  in  the  t  direction,  to  the  plot  vector 
array  x  values.  Scale  the  added  values  appropriately. 

if  (wf lag  ==  0  i I  wf lag  ==  2) 

{ 

j  =  (int)(tdi  /  dt)  *  2; 
if  (j  >=  0) 

{ 

aline  =  &llne ( j 1 ; 
j  =  0; 

} 

else 

{ 

aline  =  &line[0]; 

j  =  -j  /  2: 

} 

for  (n  =  0  :  n  <  np  ;  n++) 

*aliae++  scale  *  xscale  *  inc[n+jl; 
aline++; 

} 

} 

If  the  scattered  wave  signal  is  to  be  plotted,  add  the  scattered 
wave  signal  x  valves,  with  the  appropriate  offset  in  t,  to  the 
plot  vector  array  x  values.  Scale  the  scattered  wave  signal 
appropriately. 

*/' 

if  (wflag  ==  1  1  I  wflag  ==  2) 

{ 

j  =»  (int )  ( t-'s  /  dt )  *  2 ; 
if  (J  >=  0, 

{ 

aline  =  line  [j  1  ; 
j  =  0; 

} 

else 

{ 

aline  =  &  line [0  1  ; 
j  =  -j  /  2; 

} 

for  (n  =  0  ;  n  <  np  ;  n+^) 

*aline++  +=  scale  *  xscale  *  scat(n+jl: 
a  I ine  ++; 

} 

} 

/* 

Draw  the  signal  trace, 

*/ 


interiorstyleCgfd,  INfSOLIO); 

polyl ine2d(gfd  ,  41ine[0],  8192,  FALSK); 


If  the  thv'cshold  filling  option  has  boon  solectod,  find  -nd  fill  all 
trace  regions  past  threshold  from  the  base  x  offsi-t  valne. 

*/ 

if  (thresh  !=  0. ) 

{ 

for  (n  =  0,  k  =  -1  ;  n  <  16384  ;  n  +=  2) 

{ 

/* 

If  the  X  value  of  the  curve  over  the  base  offset  is  greater  than  the 
threshold,  start  the  fill  process. 

*/ 

if  ((line[n]  -  xd)  /  thresh  >=  1.) 

{ 

/* 

If  this  is  the  first  point  of  the  region  to  fill,  then  set  the 
point  of  the  plot  vector  array  with  the  point  at  which  the 
line  crosses  the  tl icshold. 

*/ 

if  (.k  <  0) 

{ 

k  =  (n  ==  0)  ?  n  :  n  -  2; 
line[k+ll  +=  (line[k+3]  -  line[k+l]) 

*  (thresh  +  xd  -  line[k]) 

/  (line[k+2)  -  line[k]); 
line[k]  =  xd  +  thresh; 

} 

} 

/* 

If  the  trace  line  is  no  longer  over  the  tlu'cshold,  then  fill  the 
region . 

*/ 

else  if  (k  >=  0) 

{ 

Set  the  point  of  the  plot  vector  array  which  ends  the  fill  region 
with  the  point  at  which  the  trace  line  crosses  the  threshold. 

*/ 

line[n+l]  =  line[n-l]  +  (line[n+l]  -  lineln-1]) 

*  (thresh  +  xd  -  line[n-2]) 

/  (line(n]  -  line[n-2]); 
line[nl  =  xd  +  thresh; 
j  =  1  +  (n  -  k)  /  2; 

/* 

I  ond  the  pi  ipriate  part  of  the  plot  vector  array  into  the  partial 
polvgon  biif  fer . 

*/ 

pa  1 1  ia  l_polygon2d(gf  d  ,  61ino[k],  j,  FAhSF,,  TKUF,); 
k  =  -1; 

} 

) 
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* 


L 


FIlI  all  regions  3elecc<_>d  previously. 

*  ' 

polygon2d(gfd ,  &line[01,  0,  FAL'IE); 
interior  style(gfd,  INT  HOLLOW); 

} 

} 

} 

/* 

Close  the  graphics  device. 

■k  ' 

/ 

gc’ioso(gfd) ; 


H.3.2.2  compat  t 

* 

Proced.jre  nar>o  :  compact 

Author  :  J.C.  Biard 

Discussion  : 

This  procedure  takes  ascii  numeric  output  and  converts  it  to 
binary.  This  allows  a  large  savings  in  memory. 

Invocation  : 

The  program  is  invoked  by  the  command 
compact  <  ifile  >  ofile 

where  ifile  is  the  ascii  input  file  and  ofile  is  the  binary 
output  file. 

This  program  nay  be  used  as  a  filter. 

Pr'oc  lutes  called  from  this  module  : 
none 

r.y. K!i  variables  : 
none 

★ 

d  i  n<_ '  ude  <s  td  io  .  h> 

mai  :i(  ) 

{ 

char  ibuffer[30],  *obuffer; 
i  nt  n ; 
double  x; 

/* 

Read  strings  of  ascii  characters  separated  by  white  space  one  at 
a  tima  until  the  end  of  the  file. 

*/ 


H-S'l 


vhi  !(:>  (scanf  (''%s"  ,  f.ibuf  fer  [0]  )  >  0) 

{ 

/* 

Seek  though  the  string  until  a  decimal  mark  or  the  end  of  string  is  found. 

*/ 

obuffer  =  ibuffer; 

while  (*obuffer  !=  &&  *obuffer  !=  ''0') 

{ 

obuf  f er ++; 

} 

/* 

If  the  seek  stopped  because  it  was  the  end  of  the  string,  consider 

it  to  be  an  integer  number  string  and  read  it  into  an  integer  variable. 
Then  write  the  binary  contents  of  the  integer  variable  to  the  output. 

*/ 

if  (*obuffer  ==  ''0') 

{ 

sscanf (Sibuf fer [0] ,  "%d",  &n); 
obuffer  =  (char  *)&n; 

fwrite(obuf fer ,  sizeofCn),  1,  stdout); 

} 

/* 

If  the  seek  stopped  because  a  decimal  mark  was  found,  consider 

it  to  be  a  decimal  number  string  and  read  it  into  a  double  variable. 
Then  write  the  binary  contents  of  the  double  variable  to  the  output. 

*/ 

else  if  (*obuffer  == 

{ 

sscanf ( & i buf f er [ 0 ]  ,  "%lg",  ix); 
obuffer  =  (char  *)&x; 

fwr i te (obuf fer  ,  sizeof(x),  1,  stdout); 

} 

else 

/* 

If  none  of  the  above  works,  write  an  error  message. 

*/ 

{ 

f  print  f  ( St  de  rr  ,  "Unrecognizable  string:  -is'n”,  ibuffer); 

} 

/* 

Push  the  output  into  the  output  file. 

*/ 

f  f lush ( stdout  )  ; 

} 

} 


H.1.7..3  Tnjujt  Par. meter  File  for  vusei_s 

This  example  input  file  for  the  program  vuseis  specifies  the  scale, 
tlir.shold  limit,  x  limits,  and  t  limits  for  the  graph.  The  form  of  the  file 
must  onform  uxaclly  to  this  example  in  terms  of  which  value  is  on  which  line, 
althoagji  the  conmunts  are  not  necessary. 
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100. 

,  0. 

4  Scale,  blacking  threshold  (<0- 

left 

,>0-righr 

,  =0-au,n  ; ) 

0., 

0. 

4  left  X  limit,  right  x  limit. 

0., 

120. 

4  starting  time  limit,  stopping 

t  i  me 

1  i  in  1  t . 

H  .  T  3  Com:non  Gr  iphic  ; _ Subrou^ 

These  subroutines  are  used  by  the  plane  wave  and  line  source  graphir.g 
programs  to  perform  the  repetitive  tasks  of  coordiriate  system  initialization, 
ch.'-^cter  sizing,  axis  drawing,  and  labeling. 

ri .  3  .  3  .  !  axis 

•k 

Procedure  :  axis 

Aut!;or  :  J.C.  Biard 

D  i  s  c '  i  s  s  i  o  n 

This  procedure  draws  a  pair  of  axes  and  option.rlly  draws 
tic  marks  on  the  axes. 

For.-a.l  Arguft.ents 

Input  : 

gfd  File  descripti:>r  of  the  graphics  device  special  file. 

xO  X  location  of  the  origin  of  the  axes. 

yO  Y  location  of  the  origin  of  the  axes, 

xstep  X  axis  tic  mark  spacing, 

ystep  Y  axis  tic  mark  spacing. 

Output  :  none 

External  V.i.iables  :  none 

■k 

axi-.(gfl,  xO,  yO,  xstep,  ystep) 
i  n  t  g  f  d  ; 

floa'  xO,  yO,  xstep,  ystep; 

f 

i  ri  t  cioap  ; 

float  phys 1 im[ 2 ]  [  3  I ,  res[3J,  pi  (3),  p2(3]; 

float  vl,  vr,  vb,  vt ,  wl ,  wr,  wb,  wt ,  dum,  vtx,  vty,  tx,  ty; 
f loat  X ,  y ; 

/* 

Cot  the  plotting  surface  limits  in  VUG  and  UC  coordinate  systems. 

*/ 

iuqui re_sizes(gfd,  physlim,  res,  pi,  p2,  Semap); 
vl  =  0. ; 

vr  =  (phy^ 1 i m[ I  1 (0 1  -  phy s 1 i m (0 J [0 ]  )  /  (phys 1  im [  1  I  (  1  1  -  ph ys 1 im [0 ] [ 1  1  ) ; 
vb  =  0. ; 
vt  =  1.; 
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V  t  X  =  V  L  y  =  .  0 1  'i ; 

vdc_to_wc  d  ,  vl  ,  vb,  0.,  ,  /ivb ,  Sdum); 

vdc_  to__wc  (gf  d  ,  vr,  vt  ,  0.,  {.wr,  &wt ,  idura); 

/* 

Get  the  tic  uiark  lengths  in  the  WC. 

*/ 

vdc_to_wc (gfd ,  vtx,  vty,  0.,  &tx,  &ty,  &dum); 
tx  -=  wl ; 
ty  -=  wb; 

/* 

Draw  the  axis  lines. 

*/ 

move2d(gfd,  wl ,  yO); 
d‘aw2d(gfd,  wr,  yO); 

.■ove2d(gfd,  xO,  wb); 
drdw2d(gfd,  xO ,  wt); 

/* 

If  xsti-p  =  0,  then  don't  draw  x  tic  narks. 

*/ 

if  (xstep  !=  0.  ) 

{ 

/* 

Draw  tic  r.arks  on  the  x-axis  from  xO  to  wr. 

*/ 

for  (x  =  xO  ;  X  <=  wr  ;  X  +=  xstep) 

{ 

nove2d(gfd,  x,  (yO  +  ty)); 
draw2d(gfd,  x,  (yO  -  ty)); 

} 


Draw  tic  narks  on  the  x-axis  from  xO  to  wl . 

*/ 

for  (x  =  xO  ;  X  >=  wl  ;  x  -=  xstep) 

{ 

move2d(gfd ,  x,  (yO  +  ty)); 
draw2d(gfd,  x,  (yO  -  ty)); 

} 

} 

’  > 

If  ystep  =  0,  then  don't  draw  y  tic  marks. 

*/ 

if  (ystep  !=  0.) 

{ 

/* 

Draw  tic  riirks  on  the  y-axis  from  yO  to  wt  . 

■I 

for  (y  =  yO  ;  y  <=  wt  ;  V  ystep) 

{ 

i:iuve2d(gf  d ,  (xO  +  tx),  y); 
draw?d(gfd,  (xO  -  tx),  v); 

} 

/* 

Draw  tic  r.  irks  on  the  y-.ixis  f  om  yO  to  wb. 


11-92 


} 


for  (y  =  yO  ;  y  >=  wb  ;  y  -=  ysLep) 

{ 

rp.ove2d(gfd ,  (xO  +  cx),  y); 
draw2d(gfd,  (xO  -  tx),  v); 

} 

} 

•3.3,2  init_coords 


P  r  0  c  e  d  u  r  e 

:  init 

coords 

Author 

:  J.C. 

Biard 

Discussion 

; 

This  procedure  sets  the  World  Coordinate  limits 
within  thio  physical  limits  of  the  graphics  device 
and  sets  default  values  for  some  graphics  options. 

Fornial  Arguments 

Input  : 

gfd  File  descriptor  for  the  graphics  device  special  file. 

wl  World  Coordinate  window  left  limit  value, 

wb  World  Coordinate  window  bottom  limit  value, 

wr  World  Coordinate  window  right  limit  value, 

wt  World  Coordinate  window  top  limit  value. 

fl  Fraction  of  plot  surface  left  of  tht  window, 

fb  Fraction  of  plot  surface  below  the  window, 

fr  Fraction  of  plot  surface  right  of  the  window, 

ft  Fraction  of  plot  surface  ab':i  e  the  wind'.'w. 

OurpMV  :  none 

F. X t ■' r ’  Variables  :  none 


i  n  i  r  d-,  (gf  d  ,  wl  ,  wb  ,  wr  ,  wt  ,  fl,  fb,  fr,  ft) 

int  gfd; 

float  wl ,  wr ,  wb ,  wt ,  fl,  fr,  fb,  ft; 

{ 

int  cmap; 

float  physUra[2]  [3]  ,  res[3],  pl(3l,  p2[3]: 
float  mat [3] [2],  vl,  vr,  vb,  vt,  sx,  sy; 

/* 

Find  the  physical  limits  of  the  graphics  device. 

*/ 

in(;uire_si7.es(gfd ,  physlim,  res,  pi,  p2,  &cmap); 

vl  =  0. ; 

vr  =  ( phy s  1  i  m (  I  1  [  0  1  -  phy s  1  iin [ 0  ]  [ 0  1  )  /  (physlira[  I  ]  [  I  1  -  physl  im[0  1  [  I  1  ) ; 


vb  =  0.  ; 

vt  =  1  •  ; 

/* 

Initia’ize  the  t:  rails  foi  ion  matrix  to  create  the  Vorld  Coordiaate 

system  as  specified. 

*/ 

sx  =  (1.  -  fl  -  fr)  *  (vr  -  vl)  /  (wr 
sy  =  ( 1 .  -  f  b  -  f  t )  *  (vt  -  vb)  /  (wt 
mat [0] [0]  =  sx; 
mat[0][l]  =  0.; 
mat [ 1 ] [ 0  ]  =  0.  ; 
mat  [  ]  [  1  ]  =  sy  : 

!nat[2l[0]  =  fl  *  (vr  -  vl)  -  sx  *  wl; 
niat[2][l]  =  fb  *  (vt  -  vb)  -  sy  *  wb; 

/* 

Set  the  Virtual  Device  Coordinate  limits  and  the  mapping  proj '-c c ion . 

*/ 

vdc  extent(pfd,  vl,  vb,  0.,  vr,  vt,  0.); 
r  ippi ng_mQde igf  d ,  TRUE  )  ; 

/* 

St.  t  the  fill  stvle  for  polygons  to  empty. 

*/ 

i  n  t  er  i  or_s  t  y  1  e  (gf  d  ,  INT_H0LI,0W ) ; 

/* 

Install  the  World  Coordinate  system. 

*/ 

pop__natrix(gfd ) ; 
push_vdc_ma t r ix (gf d  ) ; 
r t  p  1  a c e_iria trix2d(gfd,  n.at); 


-  wl ) ; 

-  wb) ; 


H .  3 .  3 .  3  c  h  a  r  a  c  t  e  r  _  s  i  2  e 


Procedure  :  cha racter__s i ze 

Author  :  J.C.  Biard 

Di  Si,  iss  i  on  : 

This  pr  .icesiure  sets  the  character  size  aid  .ispect  r.itio. 


Formal  Argum.iils 


gfd 

he i ght 
f  a  r  t  o  r 


Kile  descriptor  for  the  graphics  device  special  fil 
The  ch.iracter  height  in  Virtual  Device  Coordinates. 
The  aspect  r.itio  of  the  ch.uact.  rs . 


Out  [lU t 


IT  uie 


I'xternal  V'ariaiiles  :  none 

*/ 


1I-9A 


T 


T 


oha;-,. 'to  t._  si  fa,  hai^’a,  fart:>_:) 
LiU  gfd; 

f  1  o  a  t  he  i  g  !u  ,  f  -1  c  tar; 

r 

I 

float:  w'.i,  who,  du.i; 


,  ’  "k 


Obtain.  Che  height  o'"'  Che  charcicters  in  IvorLi  Coordina'-es , 

vdc_  to_  wc(gfd  ,  0.,  0.,  0.,  &du'Ti,  &wh0,  idui); 
vda^ti:g  we  (gfd  ,  0.,  height,  0.,  &dur.i,  &w!i ,  ^dvita); 
wh  --  wl:0; 


Sc  >. 

*  ' 

the  chare.cter  he; 

.ght  . 

cha 

/'* 

r  c;  ter__he  ight  (gfd  , 

,  wh ) ; 

Obt 

* 

at-',  the  character 

width 

vdc  to  w-rf  -fd,  0.,  0.,  0.,  £iwh0,  idean,  idam)  ; 

vdc  t^i_w\;(gfd ,  (factor  *  height),  0.,  0.,  &wh,  Jidt'.-n,  Sdun); 

-.V,  If- 


the  chi'.icCer  wi.lt  h. 
'^'T  width(5fd,  wh); 


H  .  1 .  1 .  ■+  x_l  abel  ; 

* 

:  X  labels; 

;  J.C.  hi  ird 


T:ii 


■  •  '  i's 


■At 


I  n  ;<■  i  C 

xO 

vO 

X  S  t  s'  p 

xba 
xjnr.p 
xl 
X  r 

f  ')  r  ;;i,»  t 

X  t  tele 

t  i  t  1  a 


.  air-'  draws  lab..  Is  below  an  x-axis  line  .;a.!  labels 
•h  .a  title. 


File  d'.’scriptor  of  the  graphics  devis'o  spiestlal  file. 

X  positi.jii  of  the  x-axis  origin  in  World  Coordinates. 

Y  position  of  the  x-axis  origin  in  World  Coord  i  nat*_'s . 

X  axis  tic  mark  increment  in  World  Coordinates. 

X  axis  origin  value  in  viser  units. 

X  a i  s  tic  m.irk  increment  in  ust'r  units. 

I. eft  boiiiiri  of  the  x-.i.xis  ip  World  Cooi  .1  i  n  a  t  s’S  . 

Ri,|ht  biPind  of  the  x-axis  in  Worl.l  Coo  rd  i  n.i  t  e  s  . 

Formit  for  writing  tic  mark  lib-'l;.  (As  used  by  priiuf.) 
Axis  title  strinii. 

Grii'h  title  string. 


H  ■)  , 


Out:  put 


r.xternul  Vuriablos  :  nuiue 

*/ 

x_]  abels  (gf  d ,  xO,  yO,  xstep,  xbase,  xjump,  xl,  xr,  for'tat,  xtitle,  title) 
char  *xtitle,  *format,  *title: 

Int  gfd; 

float  xO,  yO,  xstep,  xbase,  xjunp,  xl,  xr; 

{ 

char  St r ing [ 20 ] ; 
int  cinap; 

float  physl  irr.[2  ]  [  3  1  ,  res[3],  pl[3],  p2[3],  extent[12]; 
float  vl,  vr,  vb,  vt ,  wl ,  wr ,  wb,  wt ,  dura; 
float  X,  y; 

/* 

Obtain  the  extent  of  Ll'.e  graphics  window  in  World  C-ki  rd  i  ua  tes . 

*/ 

i  nqn  i  re_s  i  zes  (gf  d  ,  physlira,  res,  pi,  p2,  f.craap); 
vl  =  0. ; 

vr  =  (pliys  1  ira  [  1  ]  [  0  1  -  physlira[0]  [0]  )  /  (physlinl  1  ]  i  1  ]  -  pliys  1  ira  [  0  ]  [  1  ]  ) ; 
vb  =  0.  ; 
vt  =  1 . ; 

vdc_to_wc(gfd ,  vl,  vb,  0.,  f.wl,  &wb,  idura); 
vdc_to_wc(gfd ,  vr,  vt ,  0.,  Swr,  &wt ,  &dura); 

/* 

Set  the  size  of  the  label  characters,  set  the  text  alig  u-ient,  and 
set  tlie  software  clipping  bouuilary  to  the  Virtual  Oevice  limits. 

*/ 

ch.)racter_size(gfd ,  .033,  .5); 

t  ex  t_3 1  i  gn:r,eii  t  ( g  f  d  ,  TA_CbNrKR,  TA_TCl'’,  0.,  "  ' 

c  1  ip_ind  i  ca  tar  (gf  d  ,  CL  i  P_T0_VI)C ) ; 

/* 

Label  the  tic  marks  n  the  right  part  of  the  x-axis  in  user  units. 

*/ 

for  (x  =  xO,  dim  =  xbase  ;  x  <=  xr  ;  +=  xstep,  dura  •*■=  xjiu.ip) 

{ 

sprint f (st ring ,  format,  dura); 

text2d(gfd,  X,  vO,  string,  W‘JRLD__COL<Ri>  i  NA  rL_r'r  XT ,  FALSE); 

} 

/* 

Label  the  tic  marks  on  the  left  part  of  the  x  axis  in  user  units. 

*/ 

for(x  -  (x0-:'-,srep )  ,  dura  =  (xbase-xjurap)  ;  x  xl  ;  x  xstep,  dura  xjunpl 

{ 

s p r i  1 1 1 f ( s I  I  i ng ,  format,  dura); 

t-xt2d(gfd,  X,  vO,  string,  WORLDjCOORi)lNAi>:  JFXr,  FALSE); 

/* 

D 1  aw  the  axis  title. 

*/ 

inquire  text  eyt(nt(gfd,  "A",  WnRl.D^COORI)  1  N  \  rK_TE  XT ,  exti'ut); 

X  (xr  +  xl  )  /  2.; 


♦ 


y  = 

yO  -  2 .  *  (ext  op 

t  [  7  1  -  e X  t ei !  t  [  '*  ]  )  ; 

c  ha  r 

acter_  size(gfd;  , 

.06,  .3); 

text 

2d(gfd,  X,  y,  xt 

Itle,  WORLD  COiJrlDlNATL  TEXl,  FALSE) 

t 

text 

al  igp.  len  t  (g  f  J  , 

TA  CENiR.’,  TA__TO!',  0.,  0.); 

D  r  aw 

the  graph  titl^' 

• 

y  == 

Cha  r 

■  otter  size(gfd. 

.0--,  .5); 

text 

2d(gfd,  X,  y,  title,  WORLD  COORD IN'AT’c,  TEXT,  FALSE); 

c  1  i  p 

in.’  i  c  a  t  )  r  (  g  f  d  , 

CUP  TO  RECT); 

.3.3 

_v_labels 

pja-o  : 

y__labels 

Aulh 

.  r  : 

J.C.  Biard 

b  i  s  c 

Vi  : 

This  pr.ocedi.ire 

draws  labels  to  the  left  of  a  y-ax 

is  line. 

For 

1  Argar.ents 

In  per  : 

gfd 

File  descriptor  of  the  graphics  de 

vice  special  file. 

xO 

X  posit  ion  of  the  y-ax  is  origin  i;\ 

W'orld  Coordinates. 

yO 

Y  position  of  the  y-axis  origin  in 

Worl.i  Coordinates. 

ystep 

Y  axis  tic  mark  inoreinont  in  World 

Coo  r I i n  :  t  e  s  . 

yba-if 

Y  axis  origin  value  in  user  unite. 

yjuL.,. 

Y  axis  tic  ta.irk  inor-.a.iont  in  user 

units. 

y  b 

Low-o-'  bonn.i  of  the  y-..-is  in  World 

Co'.'  r.d  i  na  te . 

Upper  bound  of  the  y-axis  in  World 

Coord [nates . 

for  *3  ‘ 

For.’.iat  for  writing  tic  mark  labels 

.  (As  used  by  printf.) 

ycitlr- 

Axis  title  string. 

0 

“  -  i ' '  * '  * 

'ioiie 

r.  vr 

rnal  Variable:;  : 

none 

* 

y_  1  ib-1  s  (gf  d ,  xO,  yO,  ystep,  ybjrf'.- ,  yjitmp,  yb,  yt,  format,  ytitle) 
:ha;‘  *ytitle,  *foriiiat  ; 
i  n  C  g  f  d  ; 

fioac  xH,  yO,  ystep,  ybaso,  yjurnp,  yb,  yt  ; 

{ 

char  St  r  iiiy,  [  20  ]  ; 
int  cwap; 

float  phya 1 im[ 2  1  ( 3  1  ,  res(3l,  pl[3],  p2[3],  extiMit(12]; 
float  vl,  vr,  vb,  vt ,  wl ,  wr,  wb ,  wl ,  dun: 
f 1 oa^  X,  y ,  maxi  on  ; 


% 


H-o; 


▼ 


*/ 


/* 


*/ 


*/ 


/* 


Obtain  Lbe  extent  of  the  graphics  wiui'ow  in  'ii’orld  C  je- rd  i  na  t  s  . 

inqu  i  re_s  i  7.es  (gf  d  ,  physlim,  res,  pi,  p2,  icr.ap); 
vl  =  0. ; 

vr  =  (physl im[ 1 ] [0 ]  -  phys 1 ira [0 ] [0 ] )  /  (phys 1 i m [ 1 ] [ 1 ]  -  phys i im [ 0 ] [ 1 ]  ) ; 
vb  =  0. ; 
vt  =  1 . ; 
maxlen  =  0. ; 

vdc_to_wc (gf d ,  vl,  vb,  0.,  &wl ,  &wb,  &dum); 
vdc_to_wc  (gf  d ,  vr,  vt,  0.,  &wr,  &wt ,  Sdu:n); 

Set  the  size  of  the  label  characters,  set  the  text  alignment,  and 
Set  the  software  clipping  boundary  to  the  Virtual  Device  I’O'-.iCs. 

character_size(gfd ,  .035,  .5); 

text_>] ignrent(gfd ,  rA_R;GHT,  rA__BASh,  0.,  n.); 
c  1  ip_i  nd  i  ca  tor  (gf  d  ,  CLLP  TO  V!)C); 

Shift  the  xO  value  over  by  tlie  width  of  one  character. 

inquire_text_extent (gfd ,  "A",  WORLD_CiiORDI NATK_ThXT ,  extent); 
xO  -=  .5  *  (extent[9]  -  extent[3]); 

Label  the  tic  marks  on  the  upper  part  of  the  y-axis  in  user  units. 


for  (y  =  yO,  dum  =  vbase  ;  y  <=  yt  ;  y  +=  ystep,  dun  +=  vjunp) 

{ 

sprint f (st r ing ,  format,  dun); 

text2d(gfd,  xO,  y,  string,  W()RLD_COORl)INAr!-;_TKXT,  RA1.SK'>; 
i  nqisi  re_t ex t_exten C  (gf  d  ,  string,  WORLD_Ct")RDlNA  r'_TRXT  ,  ex  t  eii t  ) ; 
X  =  e  X  t  c  n  t  [  9  ]  -  e  x  r  e  n  t  [  3  ] ; 

::;>.xlen  =  (x  >  maxlen)  ?  x  :  maxlen; 


/* 


*/ 


Label  the  tic  narks  on  the  1  :'wer  part  of  the  y-axis  in  user  units. 
for(y  =  (yO-ystep),  dun  =  (ybase-y jump )  ;  y  yb  ;  y  -=  ystep,  dum 


{ 


sp r  i  n t f ( s t r i ng ,  format,  dun); 

text2d(gfd,  xO,  y,  string,  A’t>RI,D_CuORDlNArK_i'KXr,  FAI.SL); 
i  nqui  re_text_extent  (gfd  ,  string,  W!nRbD_C'>i')Rr)  i  NA  rE_TKXT  ,  extent); 
X  =  extent  [9]  -  extt-nt(3]; 
m.ixlen  --  (x  >  ir.axler.)  ?  x  :  mixlon; 


/* 


Dr  iw  the  axis  title. 


ch.iraeter  size  (gfd,  .06,  .5); 

t  e  X  t_a  1  i  g7i i;,e n  t  ( g  f  d  ,  TA_K  I  t.HT ,  tAJi A  I.F ,  0 .  ,  0 .  )  ; 
i  nq  !  i re_ tixt_exti'nt (gf d ,  "A",  WOKLD_COORDlNATK  IKXT,  extent); 
y  =  (yb  +  yt  )  /  2.  ; 

X  “  xO  -  2.5  *  (extent [9]  -  extent [3])  -  naxlen; 
text?d(gfH,  X,  y,  ytitle,  KORI.I)  CoORDlN’ATK  TEXT,  FAISK); 
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texti^alijjiunent  (gfd,  TA^RLOKT,  TA_CAP ,  0.,  0.): 

X  +=  ex' eat [9]  -  extent [3  I; 

toxt2d(gfd,  X,  y,  "s",  Wi)RLD_COORniNA  -:_TKXr,  FAI.SK); 
cl ip_ind 1 ca to r (gf d  ,  CLIP  TO  RLCl); 

}  ' 


H . 3 . 3 . 6  1 a he  1 s  _  r 

/* 

Procedure  :  y  lahels  r 

Author  :  J.C.  Biard 

0  i  3  c  u  s  a  i  o  !i  : 

Thia  procedure  draws  labels  Co  the  right  of  a  y-axis  line. 

For:p.ii  Argut’.eats 

Input  ; 

gfd  File  descriptor  of  the  grapliics  device  special  file. 

xO  X  position  of  Che  y-axis  origin  in  World  Coordinates. 

yO  Y  position  cf  the  y-axis  origin  in  World  Coor  J  i  :i  1 1  e  s . 

ystep  Y  axis  tic  mark  increment  in  World  Coordinates. 

ybase  Y  axis  origin  value  In  user  units. 

yjutip  Y  axis  tic  mark  increment  in  user  ui'.its. 

yb  Lower  bound  of  the  y-axis  in  World  Coordinates. 

yt  Upper  bound,  of  the  y-axis  in  World  Coordinates. 

format  Format  for  writing  tic  mark  labels.  (As  used  by  printf.) 

ytitle  Axis  title  string. 

Output  ;  none 

F.xt " c.a  1  Variables  :  noire 

it 

'-’_t(.-fl,  xO,  yO,  ystep,  yba<.',  yjunp,  yb,  yt  ,  format,  ytitle) 
ciia.  ;■  t  i  t  I  e  ,  *f^ir.::lt; 
i  n  t  g  f  ; 

fl'i.r  :<0 ,  vO,  '/step,  vbase,  vjunp,  vb,  vt  ; 

{ 

char  St  ring (20); 
int  craap; 

float  physl  ini[  2  1  [  3  1  ,  res[3l,  pl(3l,  p2(3),  exteiir[12]; 
float  vl,  vr,  vb,  vt ,  wl ,  wr ,  wb ,  wt ,  dum; 
float  X,  y,  maxlen; 

/* 

Obtain  the  extfUit  of  the  gr.aphics  window  in  World  Coordinates. 

inquire  si/.e';(gfd,  physlim,  res,  pi,  p2,  ficmap); 
vl  =  o.T 

vr  •  (phy s  1  i  in (  1)  [ 0  1  -  phy s  1  i  m [ 0  ]  ( 0  ]  )  /  (physl  lm[  1  ][  1  ]  -  physl  ini[0  ]  [  I  1  ) ; 


il~99 


i 

i 

I 

5 


I 


% 

\ 


i  - 


vb  =  0. ; 
vL  =  1 .  ; 
maxlen  =  0. ; 

vdc  to  wcCgfd,  vl ,  vb,  0.,  &wl ,  &wb,  &dun); 
vdc  to  wcCgfd,  vr,  vt  ,  0.,  &wr,  &wt ,  ^>dura); 

/•*  ~  ~ 

Set  the  size  of  the  label  characters,  set  the  text  alignr.ent,  and 
set  the  software  clipping  boundary  to  the  Virtual  Device  limits. 

*/ 

character_size(gfd ,  .04,  .5); 

text_al  ign::ient  (gfd ,  TA_I.EFT,  TA_HALF,  0.,  0.); 
c 1 ip_ind ioa  tor (gf d  ,  CLl P_T0_VDC ) ; 

/* 

Shift  'he  xO  value  over  by  the  width  of  one  character. 

*/ 

inquire  text_extent  (gfd  ,  "A",  WORLD^^CtHJRD  t  VATF.^PFXT ,  extent); 
xO  -=  .5  *  (otent[9]  -  extent[3]); 

/* 

hnbel  the  tic  narks  on  the  upper  part  if  the  y-axis  in  ..'.sur  units. 

★  ' 

for  Cy  =  yO,  dura  =  vbase  ;  y  <=  yt  ;  y  +=  ystep,  due  +=  yjur.p) 

{ 

sprintf (string  ,  format,  dum); 

text2d(gfd,  xO,  y,  string,  WoRLD_C00KDl  SATK_Tr:XT ,  FALSE); 

i nqu i re_t ex t_exten t (gf d ,  string,  WORLD_COORDINATE_rEXT ,  extent); 

X  =  extent[9]  -  extent[3l; 

naxlen  =  (x  >  maxlen)  ?  x  :  maxlen; 

} 

I* 

Label  the  tic  narks  on  the  lower  part  of  the  y-axis  in  user  uivirs. 

*/ 

for(y  =  (vO  "v^itep ) ,  dura  =  ( vbase-v  j urap )  ;  y  >=  vb  ;  v  -=  vstep,  duia 

{ 

spr  i  n  t  f  ( s  t  r  •' ng  ,  fornat,  dura); 

tfcxt2d(gfd,  xO,  y,  string,  W0RLD_C00R1)  i  NATE_rEXT ,  FALSE); 
i  nqui  re_text__extent  (gfd  ,  string,  WORLD  COilROl  \'A  TE_rK  XT ,  extent); 
X  =  extHnt[9]  -  extentl3]; 
maxlen  =  (x  >  raaxlen)  ?  x  :  maxlen; 

) 

/* 

Draw  the  axis  title. 

*/ 

cha  r  ac  t  er__s  i  ’e  (g  f  d  ,  .04,  .5); 
text_alignn.uit(grd,  TAJ.EFT,  TA_HALF,  0,,  0.); 
i  nqui  re_text__extt'Ut  (gfd  ,  "A”,  WORLD  COOKDIN'ArE_rLXT,  extent); 
y  =  (yb  +  yt  )  /  2. ; 

X  “  xO  +  2.5  *  (extent[9]  -  extent(3J)  e  rnixlen; 
text_p..th(gfd  ,  RA1'H_D0WN); 

text2d(gfd,  X,  y,  ytitle,  WORLD_COORDrNATE_TEXT,  FAI.SE); 
tixt_path(gfd ,  RATH  RIGHT); 
r  1  i  p_i  nd i c a  t  o  r ( g f  d ,“gL I P_TO_RECT ) ; 
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